Color Rows not filling in correctly

Darren Smith

Well-known Member
Joined
Nov 23, 2020
Messages
631
Office Version
  1. 2019
Platform
  1. 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.

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:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
I`ve created a code to count empty rows but how can I join that to the fill-in rows color sub in the post


VBA Code:
Sub CountBlankRows()

    Dim r As Range
    Dim ws As Worksheet
    Dim LastRow As Long

    
    Set ws = ThisWorkbook.Worksheets("Job Card Master")

    With ws
    
    Set r = Range(Cells(13, 3), Cells(Rows.Count, 3).End(xlUp))
    
    MsgBox r.SpecialCells(xlCellTypeBlanks).Count
    
    r.SpecialCells(xlCellTypeBlanks).EntireRow.Select

   End With
    
End Sub
 
Upvote 0
Why do you want to count rows?
You stated at a cross post that the number of blank rows is not consistent.
The only consistent thing you have to go by is column C in the next row.
 
Upvote 0
Please can you show me what I should do to make it work? I`ve spent most of today trying to make work.
 
Upvote 0
Try this
VBA Code:
Sub colorAbove(rng As Range)
    Dim i As Long, rrg As Range

    For i = 1 To rng.Rows.Count
        Set rrg = rng.Rows(i)
        ' count non blank cells in rrg
        If WorksheetFunction.CountA(rrg) = 0 Then
            ' look at C in next row
            If rrg.Offset(1).Cells(3) <> "" Then
                ' C not empty color rrg row
                rrg.Interior.ColorIndex = 36
            End If
        End If
    Next i

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,563
Messages
6,114,329
Members
448,564
Latest member
ED38

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