Color fill Function

Darren Smith

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

VBA Code:
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,737
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
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

Active Member
Joined
Nov 23, 2020
Messages
420
Office Version
  1. 2019
Platform
  1. Windows
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?
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: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
 
Last edited by a moderator:

RoryA

MrExcel MVP, Moderator
Joined
May 2, 2008
Messages
36,737
Office Version
  1. 365
  2. 2019
  3. 2016
  4. 2010
Platform
  1. Windows
  2. MacOS
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:

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

in the first section.
 
Solution

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
420
Office Version
  1. 2019
Platform
  1. Windows
That's fine thanks very much.
Please read my other question as to Color Rows not filling in correctly
 

Watch MrExcel Video

Forum statistics

Threads
1,130,244
Messages
5,641,055
Members
417,190
Latest member
Sdwd76

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