Excel Loop, Calculate and Colour Macro Skipping Cells

user_12925123 0
Viewed 56

In row 9 I have a set of standard benchmark numerical values but not all cells are populated. In rows 10 to 29 are a set of test results but sometimes not all rows will be populated and/or not all cells within rows will be populated. Example image attached.

I have put together the following code to loop through the range and highlight test results that are either 5-10%, 10-15% or 15+% greater than the benchmarks or 5-10%, 10-15% or 15+% lower than the benchmarks.

It seems to work for some results but skips others. Can anyone see what the issue is?

Thanks

Sub HighlightStats()
   Dim r As Long, c As Long
   
   With ThisWorkbook.Sheets("Summary")
   
    For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) >= Cells(9, c) * 1.05 And Cells(r, c) < Cells(9, c) * 1.1 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(211, 222, 241)
      Next c
   Next r
   
   For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) >= Cells(9, c) * 1.1 And Cells(r, c) < Cells(9, c) * 1.15 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(180, 198, 231)
      Next c
   Next r
   
    For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) >= Cells(9, c) * 1.5 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(110, 145, 208)
      Next c
   Next r
   
    For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) <= Cells(9, c) * 0.95 And Cells(r, c) > Cells(9, c) * 0.9 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(237, 219, 236)
      Next c
   Next r
   
   For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) <= Cells(9, c) * 0.9 And Cells(r, c) > Cells(9, c) * 0.85 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(223, 189, 221)
      Next c
   Next r
   
   For r = 10 To 29
      For c = 4 To 63
         If Cells(9, c) <> "" And Cells(r, c) <= Cells(9, c) * 0.85 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(207, 157, 205)
      Next c
   Next r

    End With

End Sub

enter image description here

vba excel
3 Answers

I have put all loops into one and fixed your Parameters (1.15 should have been 1.5):

Sub HighlightStats()

    Dim r As Long, c As Long
    Dim sngCell As Single

    With ThisWorkbook.Sheets("Summary")
        For r = 10 To 29
            For c = 4 To 63
                sngCell = Cells(9, c).Value
                If sngCell <> "" And Cells(r, c) >= Cells(9, c) * 1.15 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(110, 145, 208)
                ElseIf sngCell <> "" And Cells(r, c) >= sngCell * 1.1 And Cells(r, c) < sngCell * 1.15 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(180, 198, 231)
                ElseIf sngCell <> "" And Cells(r, c) >= sngCell * 1.05 And Cells(r, c) < sngCell * 1.1 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(211, 222, 241)
                ElseIf sngCell <> "" And Cells(r, c) <= sngCell * 0.95 And Cells(r, c) > sngCell * 0.9 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(237, 219, 236)
                ElseIf sngCell <> "" And Cells(r, c) <= sngCell * 0.9 And Cells(r, c) > sngCell * 0.85 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(223, 189, 221)
                ElseIf sngCell <> "" And Cells(r, c) <= sngCell * 0.85 And Cells(r, c) <> "" Then Cells(r, c).Interior.Color = RGB(207, 157, 205)
                End if
             Next c
        Next r
    End With
 
End Sub
user_61103710

I have simplified the multiple loops into one loop, removed the redundant With..End With statements, corrected an incorrect inequality, and improved the logic unit.

Dim r As Long, c As Long
For r = 10 To 29
    For c = 4 To 63
        If Cells(9, c) = "" Or Cells(r, c) = "" Then Next c
         
        If Cells(r, c) >= Cells(9, c) * 1.05 Then
            If Cells(r, c) < Cells(9, c) * 1.1 Then Cells(r, c).Interior.Color = RGB(211, 222, 241)
            ElseIf Cells(r, c) < Cells(9, c) * 1.15 Then Cells(r, c).Interior.Color = RGB(180, 198, 231)
            Else: Cells(r, c).Interior.Color = RGB(110, 145, 208)
        End If

        If Cells(r, c) <= Cells(9, c) * 0.95 Then
            If Cells(r, c) > Cells(9, c) * 0.9 Then Cells(r, c).Interior.Color = RGB(237, 219, 236)
            ElseIf Cells(r, c) > Cells(9, c) * 0.85 Then Cells(r, c).Interior.Color = RGB(223, 189, 221)
            Else: Cells(r, c).Interior.Color = RGB(207, 157, 205)
        End If
    Next c
Next r
user_43619990

I won't even start looking at the code, because a new feature has been added to Excel in order to handle such situations automatically, it's called conditional formatting, and it's explained in this URL.

In case you have problems getting it realised, there are plenty of questions on that subject here on the site, there even is a "conditional-formatting" tag foreseen for it.

Good luck

user_42791550
Related