Excel Macro works slow, how to make it faster? - vba

Question

Stackovwerflow community.
I do believe that this question was asked x1000 times here, but i just wasn not able to find a solution for my slow macro.
This macro serves for unhiding certain areas on worksheets if correct password was entered. What area to unhide depends on cell value. On Sheet1 i have a table that relates certain cell values to passwords.
Here's the code that i use.
1st. Part (starts on userform named "Pass" OK button click)
Private Sub CommandButton1_Click()
Dim ws As Worksheet
DoNotInclude = "PassDB"
For Each ws In ActiveWorkbook.Worksheets
If InStr(DoNotInclude, ws.Name) = 0 Then
Application.ScreenUpdating = False
Call Module1.Hide(ws)
Application.ScreenUpdating = True
End If
Next ws
End Sub
2nd Part.
Sub Hide(ws As Worksheet)
Application.Cursor = xlWait
Dim EntPass As String: EntPass = Pass.TextBox1.Value
If EntPass = Sheet1.Range("G1").Value Then ' Master-Pass, opens all
Sheet1.Visible = xlSheetVisible
ws.Unprotect Password:="Test"
ws.Cells.EntireRow.Hidden = False
Pass.Hide
Else
Dim Last As Integer: Last = Sheet1.Range("A1000").End(xlUp).Row
Dim i As Integer
For i = 2 To Last
Dim region As String: region = Sheet1.Range("A" & i).Value
Dim pswd As String: pswd = Sheet1.Range("B" & i).Value
If EntPass = pswd Then
ws.Unprotect Password:="Test"
ws.Cells.EntireRow.Hidden = False
Dim b As Integer
Dim Last2 As Integer: Last2 = ws.Range("A1000").End(xlUp).Row
For b = 2 To Last2
ws.Unprotect Password:="Test"
If ws.Range("A" & b).Value <> region Then
ws.Range("A" & b).EntireRow.Hidden = True
End If
If ws.Range("A" & b).Value = "HEADER" Then
ws.Range("A" & b).EntireRow.Hidden = False
End If
ws.Protect Password:="Test"
Next b
End If
Next i
End If
Application.Cursor = xlDefault
Sheet2.Activate
Sheet2.Select
Pass.Hide
End Sub
It works fast enough if I enter master-pass to get access to every hidden area, but if i enter cell.value related password, it takes about 5-6 minutes before macro will unhide required areas on every worksheet.
I'd be really grateful if someone could point out the reasons of slow performance and advise changes to be made in code. Just in case, i've uploaded my excel file here for your convenience.
http://www.datafilehost.com/d/d46e2817
Master-Pass is OPENALL, other passwords are "1" to "15".
Thank you in advance and best regards.

Answer 1

Try batching up your changes:
Dim rngShow as Range, c as range
ws.Unprotect Password:="Test" 'move this outside your loop !
For b = 2 To Last2
Set c = ws.Range("A" & b)
If c.Value = "HEADER" Then
c.EntireRow.Hidden = False
Else
If c.Value <> region Then
If rngShow is nothing then
Set rngShow = c
Else
Set rngShow=application.union(c, rngShow)
End If
End If
End If
Next b
If Not rngShow is Nothing Then rngShow.EntireRow.Hidden = False
ws.Protect Password:="Test" 'reprotect...

Answer 2

You might also want to toggle Application.Calculation = xlCalculationManual and Application.Calculation = xlCalculationAutomatic
You can also try moving your Application.Screenupdating code out of the loop, it's going to update for every sheet as written.
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Application.ScreenUpdating = False ''<- Here
DoNotInclude = "PassDB"
For Each ws In ActiveWorkbook.Worksheets
If InStr(DoNotInclude, ws.Name) = 0 Then
Call Module1.Hide(ws)
End If
Next ws
Application.ScreenUpdating = True ''<- Here
End Sub