VBA cell format that contain a specific percentage value

Question

I have VBA code that loops through cells to find percentage value and highlight them accordingly on a click of a checkbox.
I have 2 checkboxes - GreaterThan100 , LessThan0 .

Private Sub GreaterThan100_Click()
    Dim lr As Long
    lr = range("A" & Rows.Count).End(xlUp).Row
    Dim c As range
    Dim rng As range
    Set rng = range("G3:G30" & lr)
    Dim find As Long
    find = 1
    Application.ScreenUpdating = False
    If GreaterThan100.Value = True Then
    For Each c In rng
        If c >= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c >= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    End If
End Sub

Private Sub LessThan0_Click()
    Dim lr As Long
    lr = range("A" & Rows.Count).End(xlUp).Row
    Dim c As range
    Dim rng As range
    Set rng = range("G3:G30" & lr)
    Dim find As Long
    find = 0
    Application.ScreenUpdating = False
    If LessThan0.Value = True Then
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    End If
End Sub

Both codes work but LessThan0 is taking significantly longer than GreaterThan100 . Any suggestions to how to make this run faster? Suggestions on improving both methods would also be helpful!

Answer 1

Firstly, check the final value in rng variable after your calculation. In general, if you are considering cell A3 to G30 then your range should be "A3:G30" . Statements lr = range("A" & Rows.Count).End(xlUp).Row and Set rng = range("G3:G30" & lr) give an impression that cell range are not being formed correctly. However my doubt may just be a false alarm, as your requirement is not fully clear with whatever you have described.

Secondly, for concise code, change the following part of your code to one shown below

Application.ScreenUpdating = False
If LessThan0.Value = True Then
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlue
           .LineStyle = xlContinuous
           .Weight = xlThick
          End With
        End If
    Next c
    Application.ScreenUpdating = True
    Else
    For Each c In rng
        If c <= find Then
          c.Select
          With Selection.Borders
           .Color = vbBlack
           .LineStyle = xlNone
           .Weight = xlThin
          End With
        End If
    Next c
Application.ScreenUpdating = True
End If

Application.ScreenUpdating = False
For Each c In rng
   If c <= find
     c.Select
     With Selection.Borders
       .Color = IIf(LessThan0.Value = True, vbBlue, vbBlack) 
       .LineStyle = IIf(LessThan0.Value = True, xlContinuous, xlNone) 
       .Weight = IIf(LessThan0.Value = True, xlThick, xlThin)  
     End With
   End If
Next c
Application.ScreenUpdating = True

Further, you can merge these two subroutines into one by taking value GreaterThan100.value and LessThan0.value as paraemeters to that single subroutine