简体   繁体   中英

Excel Macro works slow, how to make it faster?

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.

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...

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM