Color Rows not filling in correctly

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
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:

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
Hi Everybody

Please can somebody help with the above?

Mt
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
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
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,051
Office Version
  1. 2010
Platform
  1. Windows
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.
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
Please can you show me what I should do to make it work? I`ve spent most of today trying to make work.
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,051
Office Version
  1. 2010
Platform
  1. Windows
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
 
Solution

Watch MrExcel Video

Forum statistics

Threads
1,130,083
Messages
5,639,980
Members
417,121
Latest member
DallyDally

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
Top