[xpost]
[/xpost]
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?
Column C has text in so the row above the text should fill with color.
I`ve pasted the code below
Code
Private Sub Body_Type_Click()
Select Case Body_Type.Value
Case ("Tippa")
Me.Toolpod_Width.Visible = False
Case ("Dropside")
Me.Toolpod_Width.Visible = False
Case ("Tippa with Toolpod")
Me.Toolpod_Width.Visible = True
Case ("Dropside with Toolpod")
Me.Toolpod_Width.Visible = True
End Select
Body_Type.Value = ("Body Type")
End Sub
Private Sub Add_Break_Lines_Click()
Dim cmb As ComboBox
Dim ws As Worksheet
Dim LastRow As Long
Dim rngToCheck As Range, rng As Range
Set ws = ThisWorkbook.Worksheets("Job Card Master")
Set cmb = Me.Add_Break_Lines
Set rngToCheck = ws.Range("A13:Q299")
For Each rng In rngToCheck
If rng.Interior.ColorIndex = 36 Then
rng.Interior.Pattern = xlNone
End If
Next rng
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
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
Display More