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.
Thanks is advance.
Nancy
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