Color fill Function

[Darren Smith]

With the function below its works fine but how can I make alter it so it will fill row Range A13 to Q last row above Text in column C of the worksheet?

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

 

[RoryA]

That function just works on whatever range is passed to it, so you need to change the code that calls it. Also, please clarify what exactly you mean by "last row above Text in column C of the worksheet"

 

[Darren Smith]

Last row with text in the cell from C13 down.
I`ve put the main code below. How can I alter the code to work with just finding text in column C?

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:Q61")
           
          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

 

[RoryA]

Please remember the code tags. (I've added them for you this time)

It looks like you've already calculated the last row and used similar syntax in the other sections, so you need:

colorAbove ws.Range("A13:Q" & lastrow)

in the first section.

 

[Darren Smith]

That's fine thanks very much.
Please read my other question as to Color Rows not filling in correctly