VBA if a row is all blank in a range of columns, highlight the blanks and the headers

[AnnAnn]

Hello,
This code works but takes 11 seconds to run on a 500 row sheet; it's part of a large main macro and I need it to run faster. I've searched Google, YouTube, and other threads on this site but can't find what I need.
Dim lastRow As Long, lastCol As Long, i As Long
Dim col As Variant
Dim headerCell As Range

lastCol = last_col(ws)
lastRow = Last_Row_For_Realsies(ws, lastCol)

Dim checkColumns As Variant
checkColumns = Array("A", "B", "C", "D", "E", "F", "G", "H", "K", "M", "P", "Q", "S", "U", "W", "Y", "AA")

For i = 3 To lastRow
Dim allBlank As Boolean

allBlank = True


For Each col In checkColumns
If ws.Cells(i, col).Value <> "" Then
allBlank = False
Exit For
End If
Next col

If allBlank Then

For Each col In checkColumns
ws.Cells(i, col).Interior.Color = RGB(255, 204, 0)
Set headerCell = ws.Cells(2, col)
headerCell.Interior.Color = RGB(0, 0, 0)
headerCell.Font.Color = RGB(255, 255, 255)
Next col
End If

Next i

 

[Micron]

Are you sure it is this portion that is slow? To verify I would put Debug.Print Time before and after each For loop. Next time you run it, check the immediate window for the start and stop times for each loop. That should tell you how long each one takes.

EDIT -Please post code, properly indented, between vba code tags. You click vba button on posting toolbar to get the tags.

 

[rollis13]

Hi to all.
I'm assuming you also have a few formulas throughout your sheet so, maybe, if you add this at the beginning of the macro:

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

and this at the end:

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .Calculate
End With

your highlighting will seem faster.

 

[AnnAnn]

Are you sure it is this portion that is slow? To verify I would put Debug.Print Time before and after each For loop. Next time you run it, check the immediate window for the start and stop times for each loop. That should tell you how long each one takes.

EDIT -Please post code, properly indented, between vba code tags. You click vba button on posting toolbar to get the tags.

Yes, I am sure. I commented out the other subs of the main macro and ran just this one and it took 11 seconds.

 

[AnnAnn]

Hi to all.
I'm assuming you also have a few formulas throughout your sheet so, maybe, if you add this at the beginning of the macro:

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

and this at the end:

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .Calculate
End With

your highlighting will seem faster.

Ahhh thank you, and my apologies for not mentioning this in my original post, but yes, I have those at the beginning and end of the main macro.

 

[AnnAnn]

Are you sure it is this portion that is slow? To verify I would put Debug.Print Time before and after each For loop. Next time you run it, check the immediate window for the start and stop times for each loop. That should tell you how long each one takes.

EDIT -Please post code, properly indented, between vba code tags. You click vba button on posting toolbar to get the tags.

I clicked the vba button but it just added

 at the beginning, it didn't indent.

 

[rollis13]

but yes, I have those at the beginning and end of the main macro.

Is the code you posted in post #1 a 'partial' of the main macro ?

 

[mumps]

See if this macro makes a difference. You will have to modify it to include the "ws" variable.

Sub ColorCells()
    Dim lRow As Long, i As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 3 To lRow
        If WorksheetFunction.CountA(Intersect(Rows(i), Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA"))) <> 17 Then
            Intersect(Rows(i), Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(255, 204, 0)
            Intersect(Rows(2), Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(0, 0, 0)
            Intersect(Rows(2), Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Font.Color = RGB(255, 255, 255)
        End If
    Next i
End Sub

 

[AnnAnn]

See if this macro makes a difference. You will have to modify it to include the "ws" variable.

Sub ColorCells()
    Dim lRow As Long, i As Long
    lRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 3 To lRow
        If WorksheetFunction.CountA(Intersect(Rows(i), Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA"))) <> 17 Then
            Intersect(ws.Rows(i), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(255, 204, 0)
            Intersect(ws.Rows(2), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(0, 0, 0)
            Intersect(ws.Rows(2), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Font.Color = RGB(255, 255, 255)
        End If
    Next i
End Sub

Thank you, mumps. I received run-time error 1004 at the 'If WorksheetFunction.....' line of code. The only thing I added to your code was ws in front of Cells, Rows and Range.

Dim lRow As Long, i As Long
    lRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For i = 3 To lRow
        If WorksheetFunction.CountA(Intersect(ws.Rows(i), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA"))) <> 17 Then
            Intersect(ws.Rows(i), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(255, 204, 0)
            Intersect(ws.Rows(2), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Interior.Color = RGB(0, 0, 0)
            Intersect(ws.Rows(2), ws.Range("A:H,K:K,M:M,P:Q,S:S,U:U,W:W,Y:Y,AA:AA")).Font.Color = RGB(255, 255, 255)
        End If
    Next i

 

[AnnAnn]

I clicked the vba button but it just added

 at the beginning, it didn't indent.

I realize now that doing that indents the code properly after it posts. Apologies.