Search for Color Rows & put the Row # on it

HunterN

Active Member
Joined
Mar 19, 2002
Messages
479
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.

Code:
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
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
If col A is blank, but has the coloured header, try
Code:
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
 
Upvote 0
If col A is blank, but has the coloured header, try
Code:
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.
 
Upvote 0
@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
Code:
.Interior.Color = [COLOR=#ff0000]5287936[/COLOR]
Also If you are likely to have headers on consecutive rows this will not work.
 
Upvote 0
@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.
 
Last edited:
Upvote 0
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.:(
 
Upvote 0

Forum statistics

Threads
1,223,907
Messages
6,175,301
Members
452,633
Latest member
DougMo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top