Search code examples
excelvbabackground-color

Colouring rows breaks after 23 lines

I have the below code which is supposed colour the rows based on the colour of the row above it. However, when I run the code, the result is as expected for around 15 lines and then it stops working and starts to colour in the rows with just text in them.

Private Sub CommandButton1_Click()

Dim Counter, No_Of_Rows, Last_Delete, No_Of_Cols As Long
Dim Col_Letter, Col_Range As String

No_Of_Rows = Cells(Rows.Count, 1).End(xlUp).Row
No_Of_Cols = Cells(2, Columns.Count).End(xlToLeft).Column

Counter = 7
Last_Delete = 1
Col_Letter = Chr(No_Of_Cols + 64)
Col_Range = "A1" & ":" & Col_Letter & "1"

Do While Counter <= No_Of_Rows
    If Cells(Counter, 1) = "Delete" Then
        Rows(Counter).Range(Col_Range).Interior.Color = RGB(153, 51, 0)
        Last_Delete = Last_Delete + 1
    ElseIf Cells(Counter, 1) = " " Or IsEmpty(Cells(Counter, 1)) Or Cells(Counter, 1) = "" Then
        Rows(Counter).Range(Col_Range).Interior.Color = Rows(Counter - 1).Cells(1, Counter - 1).Interior.Color
    Else
        If Last_Delete = 1 Then
            If Rows(Counter - 1).Cells(1, Counter - 1).Interior.Color = RGB(255, 255, 255) Then
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(221, 217, 196)
            Else
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(255, 255, 255)
            End If
        Else
            If Rows(Counter - Last_Delete).Cells(1, Counter - 1).Interior.Color = RGB(255, 255, 255) Then
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(221, 217, 196)
                Last_Delete = 1
            Else
                Rows(Counter).Range(Col_Range).Interior.Color = RGB(255, 255, 255)
                Last_Delete = 1
            End If
        End If
    End If
    
    Counter = Counter + 1
    
    Loop

End Sub

enter image description here

I am not sure why this happens, I have changed the values around and the error still occurs after a few iterations.

Solution 
  • Private Sub CommandButton1_Click()

    Dim ws As Worksheet, LastRow As Long, NoOfColumns As Long
    Dim dColor As Long, dLastColor As Long, r As Long
    Dim COLOR1 As Long, COLOR2 As Long, COLOR3 As Long
    
    COLOR1 = RGB(255, 255, 255)
    COLOR2 = RGB(221, 217, 196)
    COLOR3 = RGB(153, 51, 0) ' delete
    dLastColor = COLOR1
    
    Set ws = ActiveSheet
    With ws
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        NoOfColumns = .Cells(2, .Columns.Count).End(xlToLeft).Column
        
        For r = 7 To LastRow
        
            If .Cells(r, 1) = "Delete" Then
                dColor = COLOR3
            ElseIf IsEmpty(.Cells(r, 1)) Or Len(Trim(.Cells(r, 1))) = 0 Then
                ' no change
                dColor = dLastColor
            Else
                ' toggle color
                If dLastColor = COLOR1 Then
                    dColor = COLOR2
                Else
                    dColor = COLOR1
                End If
                dLastColor = dColor
            End If
            
            ' color row
            .Cells(r, 1).Resize(, NoOfColumns).Interior.Color = dColor
        
        Next
    End With

End Sub