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:

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,051
Office Version
  1. 2010
Platform
  1. Windows
I see you are getting lastrow from column C. I guess the unacknowledge suggestion to your thread here was of use.

If the code is working for all but 2 rows I'd suspect an issue with the sheet not the code
Think you are only actually needing to be working with the 17 cells from column A to column Q rather than all 16,384 cells in the row.
Did notice in file you provided in other thread that something does exist on that sheet in columns S to Y near bottom of data.
Perhaps something that had to do with that is coming into the picture.
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
I see you are getting lastrow from column C. I guess the unacknowledge suggestion to your thread here was of use. Yes I have done this and it worked and have acknowledge the question. As in ticked the right answer just now

If the code is working for all but 2 rows I'd suspect an issue with the sheet not the code
Think you are only actually needing to be working with the 17 cells from column A to column Q rather than all 16,384 cells in the row.
Did notice in file you provided in other thread that something does exist on that sheet in columns S to Y near bottom of data.
Perhaps something that had to do with that is coming into the picture.
I thought I set it to column Q?
 

Darren Smith

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

ADVERTISEMENT

Please can someone help today? This question is a different issue from my other thread.
 

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,051
Office Version
  1. 2010
Platform
  1. Windows
I thought I set it to column Q?
yes you're right, you have.

Using the file linked to in that other thread by commenting out most of the form initialization so that I can run it,
and replacing the code with what you've posted here,
if Break Lines 3 Page Job Card is selected in the user form, the following lines are colored
22, 27, 40, 50, 55, 58, 70, 76, 81, 85, 89, 99, 111, 121 (due to excess blank lines), 129, 141, 144, 147 and 150
is this not what you're wanting ?
 

Darren Smith

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

ADVERTISEMENT

yes you're right, you have.

Using the file linked to in that other thread by commenting out most of the form initialization so that I can run it,
and replacing the code with what you've posted here,
if Break Lines 3 Page Job Card is selected in the user form, the following lines are colored
22, 27, 40, 50, 55, 58, 70, 76, 81, 85, 89, 99, 111, 121 (due to excess blank lines), 129, 141, 144, 147 and 150
is this not what you're wanting Problem is it was working before but now seems to of stopped working
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
Could I send to you the latest workbook so you can see what the issue is?
 
Last edited:

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,051
Office Version
  1. 2010
Platform
  1. Windows
Sure, just share a link to it and I'll have a look
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
419
Office Version
  1. 2019
Platform
  1. Windows
Here you go


 

Watch MrExcel Video

Forum statistics

Threads
1,130,083
Messages
5,639,977
Members
417,120
Latest member
Pavithra devi

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