Wednesday, May 13, 2015

Excel Marco for assigning stars for p values, delete diagonal pattern of cells

***set e to bonferroni, if no bonferroni, set e to 1

Sub bstars()
   
Dim c As Range, e As Long
e = 10
For Each c In Selection
    If IsNumeric(c) And c < 0.001 / e Then c = "$^{***}$"
    If IsNumeric(c) And c < 0.01 / e Then c = "$^{**}$"
    If IsNumeric(c) And c < 0.05 / e Then c = "$^{*}$"
    If IsNumeric(c) And c < 0.1 / e Then c = "$^{#}$"
    If IsNumeric(c) And c < 0.01 Then c = "$^{#3}$"
    If IsNumeric(c) And c < 0.05 Then c = "$^{#2}$"
    If IsNumeric(c) And c < 0.1 Then c = "$^{#1}$"
    If IsNumeric(c) And c >= 0.1 Then c.ClearContents
Next
   
End Sub

Remove all cells in a matrix except the diagonal. (Copy from http://stackoverflow.com/questions/16057311/excel-macro-deleting-pattern-of-cells)

Sub diagonal()

    Dim tmpRNG As Range
    Set tmpRNG = Selection
    Dim tmpOff As Long

        tmpOff = tmpRNG.Row - tmpRNG.Column

    Dim cell As Range
    For Each cell In tmpRNG '.Cells
        If cell.Row - tmpOff <> cell.Column Then cell.ClearContents
    Next cell
End Sub

#The following two are modified just to remove all upper or lower diagonals...

Sub rmlower()

    Dim tmpRNG As Range
    Set tmpRNG = Selection
    Dim tmpOff As Long

        tmpOff = tmpRNG.Row - tmpRNG.Column

    Dim cell As Range
    For Each cell In tmpRNG '.Cells
        If cell.Row - tmpOff >= cell.Column Then cell.ClearContents
    Next cell
End Sub


Sub rmupper()

    Dim tmpRNG As Range
    Set tmpRNG = Selection
    Dim tmpOff As Long

        tmpOff = tmpRNG.Row - tmpRNG.Column

    Dim cell As Range
    For Each cell In tmpRNG '.Cells
        If cell.Row - tmpOff <= cell.Column Then cell.ClearContents
    Next cell
End Sub


Sub RoundNumbers()
Dim c As Range, e As Long
e = 2
For Each c In Selection
    If IsNumeric(c) And c <> "" Then c = Application.WorksheetFunction.Round(c, e)
Next
End Sub