insert coloured row above filled in cells

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
378
Office Version
  1. 2019
Platform
  1. Windows
I`ve got ranges on spreadsheets which need a coloured row inserted above the rows which have the data filled into cells.

Trust this makes sense? if not please tell me
 

EFANYoutube

Board Regular
Joined
May 19, 2017
Messages
162
It's been a journey my friend but I t5hink we got there

VBA Code:
Sub Color()

Dim row As Range
Dim sheet As Worksheet
Set sheet = Sheet1
Dim EmptyRowNum As Integer

For i = 1 To sheet.UsedRange.Rows.Count

    Set row = sheet.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        EmptyRowNum = EmptyRowNum + 1
    Else
        EmptyRowNum = 0
    End If

    If EmptyRowNum = 2 Then
        EmptyRowNum = 0
        row.EntireRow.Interior.ColorIndex = 4
    End If

Next i

End Sub
 

Some videos you may like

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
378
Office Version
  1. 2019
Platform
  1. Windows
I sure this will work fine. But how can I link it to the variable "Page Index" with the ranges?
See Below

VBA Code:
Sub Page_Index()

Dim Lb As ListBox
Dim ws As Worksheet
Set Lb = Body_And_Vehicle_Type_Form.ListBox3
Set ws = ThisWorkbook.Sheets("Job Card with Time Analysis")

If Lb.Value = ("1 Page Job Card Master.xlsm") Then
ws.Activate
Range("A13:N67").Select
End If

If Lb.Value = ("2 Page Jobcard Master.xlsm") Then
ws.Activate
Range("A13:N61", "A66:N120").Select
End If

If Lb.Value = ("3 Page Jobcard Master.xlsm") Then
ws.Activate
Range("A13:N61", "A66:N122", "A127:183").Select
End If

If Lb.Value = ("4 Page Jobcard Master.xlsm") Then
ws.Activate
Range("A13:N61", "A66:N122", "A127:183", "A188:N244").Select
End If

If Lb.Value = ("5 Page Jobcard Master.xlsm") Then
ws.Activate
Range("A13:N61", "A66:N122", "A127:183", "A188:N244", "A249:299").Select
End If

End Sub
 

EFANYoutube

Board Regular
Joined
May 19, 2017
Messages
162
I'll take the last one as an example

VBA Code:
If Lb.Value = ("5 Page Jobcard Master.xlsm") Then
ws.Activate
Range("A13:N61", "A66:N122", "A127:183", "A188:N244", "A249:299").Select
End If

Are there 2 empty rows above the range A13:N61 or are there 2 empty rows within this range?
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
378
Office Version
  1. 2019
Platform
  1. Windows
There are 2 empty rows above all filled in rows in the range.
 

EFANYoutube

Board Regular
Joined
May 19, 2017
Messages
162

ADVERTISEMENT

I don't know how you have set things up so hard for me to test so I have not tested it but this should work
If you get any errors let me know
VBA Code:
Sub Page_Index()

Dim Lb As ListBox
Dim ws As Worksheet
Set Lb = Body_And_Vehicle_Type_Form.ListBox3
Set ws = ThisWorkbook.Sheets("Job Card with Time Analysis")

With ws
    Select Case Lb.Value
        Case Is = "1 Page Job Card Master.xlsm"
            Color .Range("A13:N67")

        Case Is = ("2 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N120")
   
        Case Is = ("3 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
   
        Case Is = ("4 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
            Color .Range("A188:N244")

        Case Is = ("5 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
            Color .Range("A188:N244")
            Color .Range("A249:299")
    end select
end with

End Sub

Function Color(Rng As Range)

Dim row As Range
Dim sheet As Worksheet
Set sheet = Sheet1
Dim EmptyRowNum As Integer

For i = 1 To Rng.Rows.Count

    Set row = Rng.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        EmptyRowNum = EmptyRowNum + 1
    End If
    If EmptyRowNum = 2 Then
        EmptyRowNum = 0
        row.EntireRow.Interior.ColorIndex = 4
    End If

Next i

End Function
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
378
Office Version
  1. 2019
Platform
  1. Windows
Sorry, it`s not working. It jumps over all the coding


VBA Code:
Private Sub Fill_Color_Change()

Dim c As Range, x As Long
Dim Com As ComboBox
Dim ws As Worksheet

Set Com = Me.Fill_Color
Set c = ActiveSheet.Range("E13:E299")
Set ws = ThisWorkbook.Sheets("Job Card Master")
For Each c In Range("E13:E299")

If Left(c, 1) = "^" Then
c.Font.ColorIndex = 54
c.Font.Italic = True
c.Font.Bold = True
End If

If Left(c, 1) = "*" Then
c.Font.ColorIndex = 45
c.Font.Italic = True
c.Font.Bold = True
End If

Next

With ws
    Select Case Com.Value
        Case Is = "1 Page Job Card Master.xlsm"
            Color .Range("A13:N67")

        Case Is = ("2 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N120")
   
        Case Is = ("3 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
   
        Case Is = ("4 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
            Color .Range("A188:N244")

        Case Is = ("5 Page Jobcard Master.xlsm")
            Color .Range("A13:N61")
            Color .Range("A66:N122")
            Color .Range("A127:183")
            Color .Range("A188:N244")
            Color .Range("A249:299")
    End Select
End With

End Sub

Function Color(Rng As Range)

Dim row As Range
Dim sheet As Worksheet
Set ws = ThisWorkbook.Sheets("Job Card Master")
Dim EmptyRowNum As Integer

For i = 1 To Rng.Rows.Count

    Set row = Rng.Rows(i)
    If WorksheetFunction.CountA(row) = 0 Then
        EmptyRowNum = EmptyRowNum + 1
    End If
    If EmptyRowNum = 2 Then
        EmptyRowNum = 0
        row.EntireRow.Interior.ColorIndex = 4
    End If

Next i

End Function
 

Darren Smith

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

ADVERTISEMENT

Sorry, it is working
But I change the range to column Q rather than N and it seems to stop working??
It puts one row to color the rest blank??
 

EFANYoutube

Board Regular
Joined
May 19, 2017
Messages
162
Hi Darren,

You have added extra code at the top that wasn't in the original post
E.G. In the original post ws was set to ThisWorkbook.Sheets("Job Card with Time Analysis")
no its set to ThisWorkbook.Sheets("Job Card Master")

The code works for me as I have just tested it
Do you want to share your workbook as it seems like there are a lot more things at play here.
 

Darren Smith

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

You have added extra code at the top that wasn't in the original post
E.G. In the original post ws was set to ThisWorkbook.Sheets("Job Card with Time Analysis")
no its set to ThisWorkbook.Sheets("Job Card Master")

The code works for me as I have just tested it
Do you want to share your workbook as it seems like there are a lot more things at play here. Yes I do please
 

Darren Smith

Active Member
Joined
Nov 23, 2020
Messages
378
Office Version
  1. 2019
Platform
  1. Windows
The extra code at the top is will not interfere with what we are doing.
And the "Job card with time analysis" was a mistake of mine it should have been "Job Card Master"
Also, it`s a Combobox rather than Listbox sorry about this.
 

Watch MrExcel Video

Forum statistics

Threads
1,127,763
Messages
5,626,727
Members
416,201
Latest member
brianhf

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