Need VBA to filter blanks across several ranges and several worksheets

[JTee]

Hello everyone, I am a VBA novice (at best) and really need help with a deadline-based problem that I have been up all night trying to solve. I have a workbook with 12 worksheets about a product, lets call it Ice Cream.

• Worksheet 1 is a csv data dump from the Ice Cream company's sales system
• Worksheets 2 though 10 are rollup sheets of formulas with totals and averages about individual Ice Cream flavors pulling from the first worksheet
  • All 9 of these worksheets are formatted exactly the same way with the same number of rows/columns of data
  • All 9 of these worksheets have four separate areas that could be filtered
    • D7:R157 - Ice Cream Sales
    • D161:R311 - Ice Cream Marketing
    • D315:R465 - Ice Cream Cost
    • D469:R619 - Ice Cream Projections
• Worksheet 11 is a rollup summary of all Ice Cream flavors in its own format
• Worksheet 12 is an instructional sheet to tell end users what the data means

I need to write simple VBA that will act on all 9 of the Ice Cream flavor worksheets (sheets 2-10) and hide rows in each of the four ranges above that have blank rows (with formulas, so really looking for "").

I came up with something that I Frankensteined together that works - but it runs VERY VERY slow (almost 2 minutes), it still filters the rows on the 3 worksheets I don't want it to touch, and it sometimes freezes up. Can anyone help me to either scrap this and start with something better (like autofiltering?), or help me make this work? Thank you!

Sub HideEmptyRows()

Dim lr As Long
Dim ws As Worksheet

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

For Each sh In Worksheets
If sh.Name <> "Summary" Or sh.Name <> "Weekly Report" Or sh.Name <> "Instructions" Then
    sh.Activate

    For i = 8 To 157
    If ActiveSheet.Cells(i, 4) = "" Then
    ActiveSheet.Cells(i, 4).EntireRow.Hidden = True
    End If
    Next i

    For i = 162 To 311
    If ActiveSheet.Cells(i, 4) = "" Then
    ActiveSheet.Cells(i, 4).EntireRow.Hidden = True
    End If
    Next i

    For i = 316 To 465
    If ActiveSheet.Cells(i, 4) = "" Then
    ActiveSheet.Cells(i, 4).EntireRow.Hidden = True
    End If
    Next i

    For i = 470 To 619
    If ActiveSheet.Cells(i, 4) = "" Then
    ActiveSheet.Cells(i, 4).EntireRow.Hidden = True
    End If
    Next i

 End If
 Next sh

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

End Sub

 

[John_w]

Try this macro.

Public Sub HideEmptyRows2()

    Dim ws As Worksheet
    Dim colD As Variant
    Dim r As Long
    Dim blankDcells As Range
    
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    For Each ws In ActiveWorkbook.Worksheets
    
        With ws
        
            If .Name <> "Summary" And .Name <> "Weekly Report" And .Name <> "Instructions" Then
                    
                'Put column D values in array for faster reading
                
                colD = .Range("D1:D" & .Cells(.Rows.Count, "D").End(xlUp).Row).Value
                
                'blankDcells are the blank ("") cells in column D whose rows will be hidden.  Initialised to D1, to avoid checking for Nothing before
                'each of the Union lines below.  Row 1 will be hidden and unhidden
                
                Set blankDcells = .Range("D1")

                For r = 8 To 157
                    If colD(r, 1) = "" Then Set blankDcells = Union(blankDcells, .Cells(r, "D"))
                Next
                For r = 162 To 311
                    If colD(r, 1) = "" Then Set blankDcells = Union(blankDcells, .Cells(r, "D"))
                Next
                For r = 316 To 465
                    If colD(r, 1) = "" Then Set blankDcells = Union(blankDcells, .Cells(r, "D"))
                Next
                For r = 470 To 619
                    If colD(r, 1) = "" Then Set blankDcells = Union(blankDcells, .Cells(r, "D"))
                Next
                
                'Hide blank rows
                
                blankDcells.EntireRow.Hidden = True
                
                'Unhide row 1
                
                .Rows(1).EntireRow.Hidden = False
                
            End If
            
        End With
        
    Next
    
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

it still filters the rows on the 3 worksheets I don't want it to touch

Your If statement should use Ands instead of Ors.

 

[JTee]

Try this macro.
...
Your If statement should use Ands instead of Ors.

Thank you, John. I tried the VBA you posted but it wasn't working for me. In frustration, I rearranged the 9 worksheets into one data range each, to see if that would make it any easier... So now all 9 worksheets have a single data range each from D7:T606. Will that make it easier? Id like to get this fixed for tomorrow's deadline, but I'm exhausted now and giving up for a few hours. Any further help would be most welcome.

 

[John_w]

In frustration, I rearranged the 9 worksheets into one data range each, to see if that would make it any easier... So now all 9 worksheets have a single data range each from D7:T606. Will that make it easier?

No, because I would still use the same technique with one For ... Next loop instead of four. Try stepping through the code by pressing the F8 key in the VBA editor and see why it isn't working.

The crucial line in each loop is this line:

If colD(r, 1) = "" Then Set blankDcells = Union(blankDcells, .Cells(r, "D"))

What is the value of colD(r, 1) when 'r' is the row number of a blank cell?

Insert the following line between each For r statement and the If colD(r, 1) = "" statement to display the column D values to help debug the code:

MsgBox r & " >" & colD(r, 1) & "<"