VBA Code efficiency/review, Code hides/autofits rows/columns

[DarkJester89]

Hello! I inherited this code from the last position holder. It works (partly, it doesn't hide the last column) but I just wanted to see if someone smarter than me could do a review, this is the longest code I've seen and I don't know if it's efficient as it can be.

It was built to:
- hide/unhide row based if column A is empty
- hide/unhide column based if row 1 is empty
- hide/unhide column based if row 2 is empty
- autofit row
- autofit column (but it crunches words)

Anything is much appreciated, thank you.

Sub Hide_ManualTrapDoor()

    Dim ws As Worksheet
    Dim lr As Integer, lc As Integer
    Dim ir As Integer, ic As Integer, er As Integer, ec As Integer
    
    If MsgBox("Please wait while your Rate Matrix is being constructed.", vbOKCancel, "NGSP") = vbCancel Then
        
        Exit Sub
        
    End If
    
    Set ws = ThisWorkbook.Sheets("BIBS & TOPIC ASSIGN")
    
    Application.Calculation = xlCalculationManual
    
    lr = ws.Range("A1048576").End(xlUp).Row
    lc = ws.Range("XFD2").End(xlToLeft).Column
    
    For ir = 3 To lr
    
        Select Case ws.Range("A" & ir).Value
            Case 0, vbNullString
                For er = ir To lr
                
                    Select Case ws.Range("A" & er).Value
                        Case Is <> 0
                        
                            ws.Rows(ir & ":" & er).EntireRow.Hidden = True
                            
                            ''GoTo x
                            
                        Case Else
                            'do nothing
                    End Select
                    
                    ir = ir + 1
                    
                Next er
            Case Else
                'do nothing
        End Select
    Next ir
    
X:
    For ic = 2 To lc
    
        Select Case ws.Cells(2, ic).Value
            Case 0, vbNullString
                For ec = ic To lc + 2
                
                    Select Case ws.Cells(2, ec).Value
                    
                        Case 0, vbNullString
                            Select Case ec
                                Case lc
                                    ws.Range(Cells(2, ic), Cells(2, ec)).EntireColumn.Hidden = True
                                    GoTo z
                                Case Else
                                    'do nothing
                            End Select
                            
                        Case Else
                            ws.Range(Cells(2, ic), Cells(2, ec)).EntireColumn.Hidden = True
                            ic = ec
                            GoTo Y
                    End Select
                    
                Next ec
            Case Else
                'do nothing
        End Select
Y:
    Next ic
    
z:
    Application.Calculation = xlCalculationAutomatic

End Sub

 

[offthelip]

One very easy way to make your code more efficient and faster is to use a variant array to copy all the data from the worksheet at the start. This will get rid of a lot oaf accesses to the worksheet. Each access to the worksheet in VBA takes a long time. I have made a few very simple changes to your code substituting references to the variant array "inarr" instead of the worksheet, this should make it a lot faster:

Sub Hide_ManualTrapDoor()

    Dim ws As Worksheet
    Dim lr As Integer, lc As Integer
    Dim ir As Integer, ic As Integer, er As Integer, ec As Integer
    
    If MsgBox("Please wait while your Rate Matrix is being constructed.", vbOKCancel, "NGSP") = vbCancel Then
        
        Exit Sub
        
    End If
    
    Set ws = ThisWorkbook.Sheets("BIBS & TOPIC ASSIGN")
    
    Application.Calculation = xlCalculationManual
    
    lr = ws.Range("A1048576").End(xlUp).Row
    lc = ws.Range("XFD2").End(xlToLeft).Column
    ' load all the data into a variant array
    inarr = Range(Cells(1, 1), Cells(lr, lc))
    
    For ir = 3 To lr
    
'        Select Case ws.Range("A" & ir).Value
        Select Case inarr(ir, 1)
            Case 0, vbNullString
                For er = ir To lr
                
                    Select Case inarr(er, 1)
                        Case Is <> 0
                        
                            ws.Rows(ir & ":" & er).EntireRow.Hidden = True
                            
                            ''GoTo x
                            
                        Case Else
                            'do nothing
                    End Select
                    
                    ir = ir + 1
                    
                Next er
            Case Else
                'do nothing
        End Select
    Next ir
    
X:
    For ic = 2 To lc
    
        Select Case inarr(2, ic)
            Case 0, vbNullString
                For ec = ic To lc + 2
                
                    Select Case inarr(2, ec)
                    
                        Case 0, vbNullString
                            Select Case ec
                                Case lc
                                    ws.Range(Cells(2, ic), Cells(2, ec)).EntireColumn.Hidden = True
                                    GoTo z
                                Case Else
                                    'do nothing
                            End Select
                            
                        Case Else
                            ws.Range(Cells(2, ic), Cells(2, ec)).EntireColumn.Hidden = True
                            ic = ec
                            GoTo Y
                    End Select
                    
                Next ec
            Case Else
                'do nothing
        End Select
Y:
    Next ic
    
z:
    Application.Calculation = xlCalculationAutomatic

End Sub

 

[DarkJester89]

@offthelip Can I ask you a question? I'm still learning VBA to sort this out, and I've identified some other modules, ...can you give me layman's term explanation of what this code does? I don't think it does what I think it does, but it's much appreciated.

 

[offthelip]

The code does exactly the same as your code, the only difference is in your code you refer directly to the worksheet many times using lines such as :

Select Case ws.Range("A" & ir).Value

this refers to the value which is in held in the cells given by the the row number ir in column A on the worksheet specified by ws
All I have done is copy all of values from the worksheet given by "ws" to a two dimensional variant arrray called "inarr in this statement:

inarr = Range(Cells(1, 1), Cells(lr, lc))

then every tine where you have referred to the worksheet value to test it for something, I have changed it to refer the copy of the values in "inarr"
so the above reference becomes:

Select Case inarr(ir,1)

Note that the Row number is the FIRST index not the second, for some odd reason MS decided to make the references as row then column when you use numbers but column then row when you use letters and numbers. Note you can't use letters to reference a variant array is has to be numbers, but you can use numbers all the time , which is what I tend to do. this is because it is difficult to convert a column number into a letter reference, e.g your last column number lc would need to be a letter reference in this statement for the line to work with letters:

inarr = Range(Cells(1, 1), Cells(lr, lc))

 

[DarkJester89]

hmm, i'll rephrase, the original code, was is it's goal? Hide rows is "" and hide columns if "", I think i want to break these down into seperate codes, it doesn't have to be together and it looks complicated.

 

[offthelip]

The original code would appear search down column A starting in row 3until it finds a blank cell in column A and then it hides all the rows with values in it below that.
It then searches across the columns from column B row 2, when it find a blank cell , it hides that column and any adjacent columns that are blank.
It does this in a very slow and inefficient way.

 

[DarkJester89]

Thanks @offthelip

Whoever trails this, here's my replacement code. I destructed and rebuilt this, hide rows, how column based on row 2 value, and autofit both column and rows afterswards.

Sub AutoFitWrappedText()
    With Range("B2:CT2").SpecialCells(xlCellTypeVisible).EntireColumn
    .ColumnWidth = 8.5 ' maximum width
    .AutoFit
    End With
End Sub
Sub AutoFitRows()
    With Range("3:74").SpecialCells(xlCellTypeVisible).EntireRow
    .RowHeight = 50 ' maximum height
    .AutoFit
    End With
End Sub

Sub HideRows()
Dim c As Range
For Each c In Range("A3:A73")
    If c.Value = 0 Or c.Value = "" Then
        c.EntireRow.Hidden = True
    Else
        c.EntireRow.Hidden = False
    End If
Next c
End Sub

Sub Hidetopcolumn()
Dim p As Range

    For Each p In Range("B2:CT2").Cells
        If p.Value = "" Then
            p.EntireColumn.Hidden = True
            
        End If
    Next p
End Sub