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

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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
 

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.

offthelip

Well-known Member
Joined
Dec 23, 2017
Messages
1,898
Office Version
  1. 2010
Platform
  1. Windows
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:
VBA Code:
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

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
@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

Well-known Member
Joined
Dec 23, 2017
Messages
1,898
Office Version
  1. 2010
Platform
  1. Windows
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 :
VBA Code:
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:
VBA Code:
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:
VBA Code:
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:
VBA Code:
inarr = Range(Cells(1, 1), Cells(lr, lc))
 

DarkJester89

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

Well-known Member
Joined
Dec 23, 2017
Messages
1,898
Office Version
  1. 2010
Platform
  1. Windows
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

Board Regular
Joined
Nov 5, 2017
Messages
94
Office Version
  1. 2016
Platform
  1. Windows
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.

VBA Code:
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
 

Forum statistics

Threads
1,136,286
Messages
5,674,856
Members
419,530
Latest member
undisclosed

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