VBA Code to Speed Up Hiding of Blank Cells/Rows in Specific Row Ranges

[bearwires]

Hi, I have put together this code to hide all blank cells in certain Row ranges across an array of worksheets.
It works ok, but it seems to take some time to complete and uses alot of computer resources to run.
Is it possible to use alternative VBA code to be more efficient and speed up the execution time and reduce the CPU/RAM usage?

Sub HideBlankRowsAllTabs()

sheetlist = Array("MS002", "MS003", "MS004", "MS005", "MS006", "MS007", "MS008", "MS009", "MS010", "MS011", "MS012")
For i = LBound(sheetlist) To UBound(sheetlist)
Worksheets(sheetlist(i)).Activate

For Each cell In Range("A330:A386")
  If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell
   
For Each cell In Range("B293:B296")
  If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell
 
For Each cell In Range("B232:B288")
  If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell

For Each cell In Range("B197:B207")
  If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell
 
For Each cell In Range("B176:B188")
  If cell.Value = "" Then cell.EntireRow.Hidden = True
    Next cell

Next
End Sub

I have a similar code to reverse the operation and unhide the rows in which I just changes the "True" to "False".

Also, is there syntax that can be added that autofits the rows/cells to the content when unhiding the rows?

Thanks

 

[johnnyL]

The previous code to hide all the cells worked perfectly earlier today but when I try it now it doesnt work, it doesnt hide ALL the blank cells with formulae in them. It works on the other cells which is just text. I havent made any changes to the document. Do you know what the issue could be?

Try the following to see if it also handles the cells with formula:

Sub HideBlankRows()
'
    Dim ArrayRow                    As Long, CellRow                As Long
    Dim LastRow                     As Long, StartRow               As Long, EndRow     As Long
    Dim ColumnToUse                 As Long
    Dim RangesToHide                As Range
    Dim ArrayOfRanges               As Variant, RangeSplitArray     As Variant
    Dim InputArray                  As Variant
'
    ArrayOfRanges = Array("A348:A404", "B311:B314", "B250:B306", "B215:B226", "B194:B206", "B132:B175", "B104:B125")
'
    Application.ScreenUpdating = False                                                                                  ' Turn ScreenUpdating off
'
    LastRow = Range("B" & Rows.Count).End(xlUp).Row                                                                     ' Get last used row of Column B
'
    InputArray = Range("A1:B" & LastRow)                                                                                ' Load data from columns A & B into 2D 1 based InputArray
'

    For ArrayRow = LBound(ArrayOfRanges) To UBound(ArrayOfRanges)                                                       ' Loop through ArrayOfRanges
        RangeSplitArray = Split(ArrayOfRanges(ArrayRow), ":")                                                           '   Split the address range into two sections
'
        If Left(RangeSplitArray(0), 1) = "A" Then ColumnToUse = 1 Else ColumnToUse = 2                                  '   If the first section of split address starts with "A" then set ColumnToUse
'                                                                                                                       '           to 1, else set ColumnToUse to 2
        StartRow = Right(RangeSplitArray(0), Len(RangeSplitArray(0)) - 1)                                               '   Get the StartRow of the split address
        EndRow = Right(RangeSplitArray(1), Len(RangeSplitArray(1)) - 1)                                                 '   Get the EndRow of the split address
'
        For CellRow = StartRow To EndRow                                                                                '   Loop through the rows of the address range
            If InputArray(CellRow, ColumnToUse) = vbNullString Then                                                     '       If the cell address is blank then ...
                If Not RangesToHide Is Nothing Then                                                                     '           If RangesToHide already has entries then ...
                    Set RangesToHide = Union(RangesToHide, Range("B" & CellRow & "" & _
                            ":" & "B" & CellRow & ""))                                                                  '               Add the Range to hide to RangesToHide
                Else                                                                                                    '           Else ...
                    Set RangesToHide = Range("B" & CellRow & "" & ":" & "B" & _
                            CellRow & "")                                                                               '               Save the Range to hide to RangesToHide
                End If
            End If
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
    If Not RangesToHide Is Nothing Then RangesToHide.EntireRow.Hidden = True                                            ' Hide all the RangesToHide rows in one swoop
'
    Application.ScreenUpdating = True                                                                                   ' Turn ScreenUpdating back on
'
    MsgBox "Completed."                                                                                                 ' Let user know that script has completed
End Sub

 

[bearwires]

Try the following to see if it also handles the cells with formula:

Sub HideBlankRows()
'
    Dim ArrayRow                    As Long, CellRow                As Long
    Dim LastRow                     As Long, StartRow               As Long, EndRow     As Long
    Dim ColumnToUse                 As Long
    Dim RangesToHide                As Range
    Dim ArrayOfRanges               As Variant, RangeSplitArray     As Variant
    Dim InputArray                  As Variant
'
    ArrayOfRanges = Array("A348:A404", "B311:B314", "B250:B306", "B215:B226", "B194:B206", "B132:B175", "B104:B125")
'
    Application.ScreenUpdating = False                                                                                  ' Turn ScreenUpdating off
'
    LastRow = Range("B" & Rows.Count).End(xlUp).Row                                                                     ' Get last used row of Column B
'
    InputArray = Range("A1:B" & LastRow)                                                                                ' Load data from columns A & B into 2D 1 based InputArray
'

    For ArrayRow = LBound(ArrayOfRanges) To UBound(ArrayOfRanges)                                                       ' Loop through ArrayOfRanges
        RangeSplitArray = Split(ArrayOfRanges(ArrayRow), ":")                                                           '   Split the address range into two sections
'
        If Left(RangeSplitArray(0), 1) = "A" Then ColumnToUse = 1 Else ColumnToUse = 2                                  '   If the first section of split address starts with "A" then set ColumnToUse
'                                                                                                                       '           to 1, else set ColumnToUse to 2
        StartRow = Right(RangeSplitArray(0), Len(RangeSplitArray(0)) - 1)                                               '   Get the StartRow of the split address
        EndRow = Right(RangeSplitArray(1), Len(RangeSplitArray(1)) - 1)                                                 '   Get the EndRow of the split address
'
        For CellRow = StartRow To EndRow                                                                                '   Loop through the rows of the address range
            If InputArray(CellRow, ColumnToUse) = vbNullString Then                                                     '       If the cell address is blank then ...
                If Not RangesToHide Is Nothing Then                                                                     '           If RangesToHide already has entries then ...
                    Set RangesToHide = Union(RangesToHide, Range("B" & CellRow & "" & _
                            ":" & "B" & CellRow & ""))                                                                  '               Add the Range to hide to RangesToHide
                Else                                                                                                    '           Else ...
                    Set RangesToHide = Range("B" & CellRow & "" & ":" & "B" & _
                            CellRow & "")                                                                               '               Save the Range to hide to RangesToHide
                End If
            End If
        Next                                                                                                            '   Loop back
    Next                                                                                                                ' Loop back
'
    If Not RangesToHide Is Nothing Then RangesToHide.EntireRow.Hidden = True                                            ' Hide all the RangesToHide rows in one swoop
'
    Application.ScreenUpdating = True                                                                                   ' Turn ScreenUpdating back on
'
    MsgBox "Completed."                                                                                                 ' Let user know that script has completed
End Sub

Yes, that works now Johnny, thanks alot