Search for Color Rows & put the Row # on it

[HunterN]

Hi,

I have a worksheet that has header rows that are colored. There is data on the rows under each header and their cell color is white. I have this vba code that I have created that reads through the worksheet and determines the number of rows between each colored row, then puts the Row # and the row count from the first row to the last row that is the color white. I have it working, but I'm wondering if there is a better way to determine the count of rows between each row that is colored.

The worksheet will start with a color row, but it does not end with a colored row.

I don't know how to show an image of my worksheet, sorry.

Sub Colored_Cells_hmm()

    Dim LastRow As Long
    Dim myRow   As Long
    Dim lastRwText As Long
    Dim firstRwChk As Boolean
    
    firstRwChk = True
    LastRwChk = True
    LastRw = 1
    NewFirstRw = 1
    
    With ActiveSheet
        LastRow = .Range("A1").SpecialCells(xlCellTypeLastCell).row
    End With
   ' MsgBox LastRow
    
    For myRow = 1 To LastRow
        With Range("A" & myRow)
         
            If .Interior.color <> vbWhite Then  'The color of the cell is not White
            
                If firstRwChk = True Then
                    firstRwChk = False
                ElseIf firstRwChk = False Then
                    lastRwText = myRow
                    Cells(LastRw, 1).Value = "Row number " & NewFirstRw & " (" & NewFirstRw & "-" & lastRwText - 1 & ")"
                
                    NewFirstRw = lastRwText
                    LastRw = lastRwText
                End If
            
            ElseIf .Interior.color = vbWhite Then
                If .Interior.color = vbWhite And myRow = LastRow Then
                    lastRwText = myRow
                    Cells(LastRw, 1).Value = "Row number " & NewFirstRw & " (" & NewFirstRw & "-" & lastRwText & ")"
                Else
                ' Do Nothing
                End If
                
            End If

        End With
    Next myRow
    
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
    
End Sub

Thanks is advance.
Nancy

 

[Fluff]

If col A is blank, but has the coloured header, try

Sub RowNumbs()

    Dim Ar As Areas
    Dim Rng As Range

    With Application.FindFormat
        .Clear
        .Interior.Color = 5287936
        Columns(1).Replace What:="", Replacement:="True", LookAt:=xlPart, _
            SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=True, _
            ReplaceFormat:=False
        .Clear
    End With
    Set Ar = Columns(1).SpecialCells(xlBlanks).Areas
    For Each Rng In Ar
        Rng.Offset(-1).Resize(1).Value = "Row number " & Rng.Offset(-1).Row & " (" & Rng.Offset(-1).Row & "-" & Rng.Offset(-1).Row + Rng.Count & ")"
    Next Rng
    
End Sub

If Col A is not blank, let me know

 

[Rick Rothstein]

If col A is blank, but has the coloured header, try

Sub RowNumbs()

    Dim Ar As Areas
    Dim Rng As Range

    With Application.FindFormat
        .Clear
        .Interior.Color = 5287936
        Columns(1).Replace What:="", Replacement:="True", LookAt:=xlPart, _
            SearchOrder:=xlByColumns, MatchCase:=False, SearchFormat:=True, _
            ReplaceFormat:=False
        .Clear
    End With
    Set Ar = Columns(1).SpecialCells(xlBlanks).Areas
    For Each Rng In Ar
       [B][COLOR="#FF0000"] Rng.Offset(-1)[/COLOR][/B].Resize(1).Value = "Row number " & [B][COLOR="#FF0000"] Rng.Offset(-1)[/COLOR][/B].Row & " (" & [B][COLOR="#FF0000"] Rng.Offset(-1)[/COLOR][/B].Row & "-" & [B][COLOR="#FF0000"] Rng.Offset(-1)[/COLOR][/B].Row + Rng.Count & ")"
    Next Rng
    
End Sub

If Col A is not blank, let me know

Won't the references I highlighted in red above have a problem when the first header (which is also blank... no value, not no color... as was assumed by you for all the cells)?

Also, where did you get the number 5287936 from? When I fill cells with white, the color number for them is 16777215.

(Untested) While I would not expect this to be the case, I do not think that your code will not work correctly if two colored cells are next to each other without any intervening white cells between them.

 

[Fluff]

@Rick Rothstein

Won't the references I highlighted in red above have a problem when the first header (which is also blank... no value, not no color... as was assumed by you for all the cells)?

Not if row 1 is header & has a colour fill.

Also, where did you get the number 5287936 from? When I fill cells with white, the color number for them is 16777215

Good point, I had forgotten to mention that the code is looking for the header rows rather than white cells & that colour ref needs to be changed to whatever colour the OP is using for the headers.

While I would not expect this to be the case, I do not think that your code will not work correctly if two colored cells are next to each other without any intervening white cells between them.

Excellent point & you're quite right, my code will fail under that scenario.
@HunterN
The colour in red here needs to be changed to match the colour of your headings

.Interior.Color = [COLOR=#ff0000]5287936[/COLOR]

Also If you are likely to have headers on consecutive rows this will not work.

 

[Rick Rothstein]

@Rick RothsteinGood point, I had forgotten to mention that the code is looking for the header rows rather than white cells & that colour ref needs to be changed to whatever colour the OP is using for the headers.

And that is why I made my first comment... I thought you were trying identify the white cells and that for some reason you screwed up the color number. I am not 100% sure that all the headers are going to be the same color... my guess is based on the OP's test was for "<>vbWhite" rather than testing for being equal to the specific header color.

 

[Fluff]

And that is why I made my first comment... I thought you were trying identify the white cells and that for some reason you screwed up the color number. I am not 100% sure that all the headers are going to be the same color... my guess is based on the OP's test was for "<>vbWhite" rather than testing for being equal to the specific header color.

Agreed.
As the Op has something that works, I was partly showing another possible solution, added to which I was bored & this looked like fun.
Unfortunately I couldn't come up with a solution that relied on the uncoloured cells, short of something similar to what the OP had posted.