How do I fill the color of the cell below the active cell if the two values are the same?-CodePudding

I have a set of data with one column that contains two specific values that should alternate down each row.

The data looks like this:

Apparently I can't post images yet. The example is this:

C2: Break C3: Normal C4: Break C5: Normal C6: Normal C7: Break C8: Normal

The goal is to fill Cell C6 Red.

The number of rows in the worksheet will change weekly, but the pattern "Break, Normal, Break" should remain consistent. When "Break, Normal, Normal" occurs, the last "Normal" needs to be filled to indicate that a break is missing.

My solution is to begin at C2, and if C3 is equal to C2, then fill C3 red. Then, step down a row and repeat the check until the end of the list. This logic would indicate that C6 turns red when C5 is Active.

I don't have a background in programming so I'm not sure if I'm approaching this the correct way, but here is the code I have:

Sub Compare_Rows()

   
    Range("C2").Select
     
    If (ActiveCell.Value = ActiveCell.Offset(1, 0).Value) Then
        ActiveCell.Offset(1, 0).Interior.ColorIndex = 3
    
    End If

        Do Until IsEmpty(ActiveCell)
        
        ActiveCell.Offset(1, 0).Select
    Loop
        

End Sub

In review I have added a break at the If and Loop lines, and the program does select each cell one row at a time. In this example when C5 is active, the tooltip for the two values in the If line confirm that the criteria (identical values) is met, but the target cell remains without any color.

The tooltip for the ColorIndex shows a color index of "-4142" at all times.

CodePudding user response：

Please, use the next code. It places the range in an array, for faster iteration/processing and build a Union range of duplicate cells value to be colored at the end of the code, at once:

   Dim sh As Worksheet, lastR As Long, rngCol As Range, arr, i As Long
   
   Set sh = ActiveSheet
   lastR = sh.Range("C" & sh.rows.count).End(xlUp).row
   
   arr = sh.Range("C1:C" & lastR).Value2
   
   For i = 2 To UBound(arr)
        If arr(i, 1) = arr(i - 1, 1) Then addToRange rngCol, sh.Range("C" & i)
   Next i
   If Not rngCol Is Nothing Then rngCol.Interior.Color = vbRed
End Sub

Sub addToRange(rngU As Range, rng As Range)
    If rngU Is Nothing Then
        Set rngU = rng
    Else
        Set rngU = Union(rngU, rng)
    End If
End Sub

Your code loops for nothing until it reaches the first empty cell...