Darren Smith
Well-known Member
- Joined
- Nov 23, 2020
- Messages
- 631
- Office Version
- 2019
- Platform
- Windows
I created a VBA code to fill in color to rows which works fine except for some reason all the rows don't fill in example row 22 and row 27. Rows 22 & 27 have text in row below in column C
Then row 26 does for some unknown reason?
The Column C has text in so the row above the text should fill with color.
Then row 26 does for some unknown reason?
The Column C has text in so the row above the text should fill with color.
VBA Code:
Private Sub Add_Break_Lines_Click()
Dim cmb As ComboBox
Dim ws As Worksheet
Dim Lastrow As Long
Set ws = ThisWorkbook.Worksheets("Job Card Master")
Set cmb = Me.Add_Break_Lines
Lastrow = ws.Cells(Rows.Count, 3).End(xlUp).Row
ws.Range("P13:P299").ClearContents
Select Case cmb.Value
Case ("Break Lines 1 Page Job Card")
colorAbove ws.Range("A13:Q"& Lastrow)
Case ("Break Lines 2 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q" & Lastrow)
Case ("Break Lines 3 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q" & Lastrow)
Case ("Break Lines 4 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q183")
colorAbove ws.Range("A188:Q" & Lastrow)
Case ("Break Lines 5 Page Job Card")
colorAbove ws.Range("A13:Q61")
colorAbove ws.Range("A66:Q122")
colorAbove ws.Range("A127:Q183")
colorAbove ws.Range("A188:Q244")
colorAbove ws.Range("A249:Q" & Lastrow)
End Select
Me.Add_Break_Lines.Text = "Add Break Lines"
End Sub
Sub colorAbove(rng As Range)
Dim brg As Range
Dim rrg As Range
Dim EmptyRowNum As Long
Dim i As Long
For i = 1 To rng.Rows.Count
Set rrg = rng.Rows(i)
If WorksheetFunction.CountA(rrg) = 0 Then
EmptyRowNum = EmptyRowNum + 1
End If
If EmptyRowNum = 2 Then
EmptyRowNum = 0
If brg Is Nothing Then
Set brg = rrg
Else
Set brg = Union(brg, rrg)
End If
End If
Next i
If Not brg Is Nothing Then
brg.Interior.ColorIndex = 36
End If
End Sub
Last edited: