Macro slowing down excessivly

W

WindowGuy

New Member
Joined
Sep 12, 2023
Messages
18
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
  3. Web
Hi all. I have 3 similar sheets that i am adding the same macro on. When I put it on all 3 it drastically slows it down a lot. Can someone advise if i wrote this correctly or if i'm missing something to make it go faster?

I have about 300 drop down options so the page is large and full of formulas.

Basically one is a quote page, the other is a quote with install and the third is a vendor one. I am trying to hide the rows of the line# cells i am not using and make it match on all three sheets.("Install Quote", "Crystal Quote", "Master Quote" or sheet "28", "29", "30"
As you can see i have made my quote to have 21 line#'s for my window quote entry(that is the range "AW" is hiding.

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Worksheets("Install Quote").Unprotect ("7712")

Dim p As PivotCache
For Each p In ThisWorkbook.PivotCaches
p.Refresh
Next p

With Application
     .Calculation = xlCalculationManual
     .ScreenUpdating = False
     .DisplayStatusBar = False
End With
    If Range("aw14") = "one" Then
        Rows("27:287").EntireRow.Hidden = True
    Else
        Rows("27:287").EntireRow.Hidden = False
    If Range("aw14") = "two" Then
        Rows("40:287").EntireRow.Hidden = True
    Else
        Rows("40:287").EntireRow.Hidden = False
    If Range("aw14") = "three" Then
        Rows("53:287").EntireRow.Hidden = True
    Else
        Rows("53:287").EntireRow.Hidden = False
    If Range("aw14") = "four" Then
        Rows("66:287").EntireRow.Hidden = True
    Else
        Rows("66:287").EntireRow.Hidden = False
    If Range("aw14") = "five" Then
        Rows("79:287").EntireRow.Hidden = True
    Else
        Rows("79:287").EntireRow.Hidden = False
    If Range("aw14") = "six" Then
        Rows("92:287").EntireRow.Hidden = True
    Else
        Rows("92:287").EntireRow.Hidden = False
    If Range("aw14") = "seven" Then
        Rows("105:287").EntireRow.Hidden = True
    Else
        Rows("105:287").EntireRow.Hidden = False
    If Range("aw14") = "Eight" Then
        Rows("118:287").EntireRow.Hidden = True
    Else
        Rows("118:287").EntireRow.Hidden = False
    If Range("aw14") = "nine" Then
        Rows("131:287").EntireRow.Hidden = True
    Else
        Rows("131:287").EntireRow.Hidden = False
    If Range("aw14") = "ten" Then
        Rows("144:287").EntireRow.Hidden = True
    Else
        Rows("144:287").EntireRow.Hidden = False
    If Range("aw14") = "eleven" Then
        Rows("157:287").EntireRow.Hidden = True
    Else
        Rows("157:287").EntireRow.Hidden = False
    If Range("aw14") = "twelve" Then
        Rows("170:287").EntireRow.Hidden = True
    Else
        Rows("170:287").EntireRow.Hidden = False
    If Range("aw14") = "thirteen" Then
        Rows("183:287").EntireRow.Hidden = True
    Else
        Rows("183:287").EntireRow.Hidden = False
    If Range("aw14") = "fourteen" Then
        Rows("196:287").EntireRow.Hidden = True
    Else
        Rows("196:287").EntireRow.Hidden = False
    If Range("aw14") = "fifteen" Then
        Rows("209:287").EntireRow.Hidden = True
    Else
        Rows("209:287").EntireRow.Hidden = False
    If Range("aw14") = "sixteen" Then
        Rows("222:287").EntireRow.Hidden = True
    Else
        Rows("222:287").EntireRow.Hidden = False
    If Range("aw14") = "seventeen" Then
        Rows("235:287").EntireRow.Hidden = True
    Else
        Rows("235:287").EntireRow.Hidden = False
    If Range("aw14") = "eighteen" Then
        Rows("248:287").EntireRow.Hidden = True
    Else
        Rows("248:287").EntireRow.Hidden = False
    If Range("aw14") = "ninteen" Then
        Rows("261:287").EntireRow.Hidden = True
    Else
        Rows("261:287").EntireRow.Hidden = False
    If Range("aw14") = "twenty" Then
        Rows("274:287").EntireRow.Hidden = True
    Else
        Rows("274:287").EntireRow.Hidden = False
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If

With Application
     .Calculation = xlCalculationAutomatic
     .ScreenUpdating = True
     .DisplayStatusBar = True
End With


End Sub
Sub NewDropDownDefault()


With Application
     .Calculation = xlCalculationManual
     .ScreenUpdating = False
     .DisplayStatusBar = False
End With

Range("N8").ClearContents
   Dim Rng As Range
   Application.ScreenUpdating = False
   On Error Resume Next
   Set Rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
   Rng.Value = "'- Choose Option -"
   On Error GoTo 0
With Application
     .Calculation = xlCalculationAutomatic
     .ScreenUpdating = True
     .DisplayStatusBar = True
End With
     
ThisWorkbook.Worksheets("Install Quote").Protect ("7712")

End Sub


Sub AllowMacroWhenProtected()

Sheets("Install Quote").Protect Password:="7712", _
    UserInterfaceOnly:=True

End Sub
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
I got part way through the If's to show you how it should have been indented, which might have shown you that every one of those If's have to be evaluated. It got too deep to carry on:
VBA Code: 
If Range("aw14") = "one" Then
   Rows("27:287").EntireRow.Hidden = True
Else
   Rows("27:287").EntireRow.Hidden = False
   If Range("aw14") = "two" Then
      Rows("40:287").EntireRow.Hidden = True
   Else
      Rows("40:287").EntireRow.Hidden = False
      If Range("aw14") = "three" Then
         Rows("53:287").EntireRow.Hidden = True
      Else
        Rows("53:287").EntireRow.Hidden = False
        If Range("aw14") = "four" Then
           Rows("66:287").EntireRow.Hidden = True
        Else
          Rows("66:287").EntireRow.Hidden = False
          If Range("aw14") = "five" Then
             Rows("79:287").EntireRow.Hidden = True
          Else
            Rows("79:287").EntireRow.Hidden = False
            If Range("aw14") = "six" Then
               Rows("92:287").EntireRow.Hidden = True
            Else
               Rows("92:287").EntireRow.Hidden = False
               If Range("aw14") = "seven" Then
                  Rows("105:287").EntireRow.Hidden = True
               Else
                  Rows("105:287").EntireRow.Hidden = False
                  If Range("aw14") = "Eight" Then
                     Rows("118:287").EntireRow.Hidden = True
                  Else
                     Rows("118:287").EntireRow.Hidden = False
                     If Range("aw14") = "nine" Then
                        Rows("131:287").EntireRow.Hidden = True
                     Else
                        Rows("131:287").EntireRow.Hidden = False
                        If Range("aw14") = "ten" Then
                           Rows("144:287").EntireRow.Hidden = True
                        Else
and many tests are repeated (such as what aw14 might contain). Instead I think I'd use a Select Case block to test the value. Also, it seems that you could speed things up by using variables because it seems you're incrementing rows by 13 and always referring to 287. Then each row hiding wouldn't have to be passed a hard coded value. Instead, the value of 13 would be retained in memory. Using memory is usually faster than passing hard coded values to commands. Just for your own information, you could debug.print a system timer value at the beginning and end of your subs (or sections within) to see how long portions are taking. That would allow you to zero in on the bottlenecks.
 
Upvote 0
There appears to be a pattern to the rows being hidden/unhidden so I think that you could avoid virtually all of the If..Then..Else..End If blocks as follows.

Rich (BB code): 
Dim Num As Variant
With Application
     .Calculation = xlCalculationManual
     .ScreenUpdating = False
     .DisplayStatusBar = False
    Num = .Match(Range("AW14").Value, Split("one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty", ","), 0)
End With

Rows("27:287").Hidden = False
If IsNumeric(Num) Then Rows(Num * 13 + 14 & ":287").Hidden = True

With Application
     .Calculation = xlCalculationAutomatic
     .ScreenUpdating = True
     .DisplayStatusBar = True
End With

Having said that, it could well be that slowness relates to Pivot Cache refreshes.
 
Upvote 0
Solution
Peter_SSs said:
There appears to be a pattern to the rows being hidden/unhidden so I think that you could avoid virtually all of the If..Then..Else..End If blocks as follows.

Rich (BB code): 
Dim Num As Variant
With Application
     .Calculation = xlCalculationManual
     .ScreenUpdating = False
     .DisplayStatusBar = False
    Num = .Match(Range("AW14").Value, Split("one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty", ","), 0)
End With

Rows("27:287").Hidden = False
If IsNumeric(Num) Then Rows(Num * 13 + 14 & ":287").Hidden = True

With Application
     .Calculation = xlCalculationAutomatic
     .ScreenUpdating = True
     .DisplayStatusBar = True
End With

Having said that, it could well be that slowness relates to Pivot Cache refreshes.
Click to expand...
Thank you Peter. Amazing. I am a beginner and you solved it. Anychance you can assist with running macros on multiple pages that are password protected? I have been trying lots of things i found on youtube but either it wont unlock or relock....

This is in workbook. I have tried more then one page(,"Installs","Crystal") but it errors out.
VBA Code: 
Private Sub Workbook_Open()

Call AllowMacroWhenProtected

End Sub


Sub AllowMacroWhenProtected()

Sheets("Master Quote DO NOT TOUCH").Protect Password:="7712", _
    UserInterfaceOnly:=True

End Sub

i have also placed the following in the pages. but if leaves it unlocked after clicking macro button. It also will not run macro if i lock it at end of each sub.


VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Worksheets("Install Quote").Unprotect ("7712")
With Application
   
Num = .Match(Range("AW14").Value, Split("one,two,three,four,five,six,seven,eight,nine,ten,eleven,twelve,thirteen,fourteen,fifteen,sixteen,seventeen,eighteen,nineteen,twenty", ","), 0)
End With

Rows("27:287").Hidden = False
If IsNumeric(Num) Then Rows(Num * 13 + 14 & ":287").Hidden = True



End Sub


Sub NewDropDownDefault()
ThisWorkbook.Worksheets("Install Quote").Unprotect ("7712")
Range("N8").ClearContents
   Dim Rng As Range
   Application.ScreenUpdating = False
   On Error Resume Next
   Set Rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeAllValidation)
   Rng.Value = "'- Choose Option -"
   On Error GoTo 0
ThisWorkbook.Worksheets("Install Quote").Protect ("7712")

End Sub
Private Sub Workbook_Open()

Call AllowMacroWhenProtected

End Sub


Sub AllowMacroWhenProtected()

Sheets("Install Quote").Protect Password:="7712", _
    UserInterfaceOnly:=True

End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Question Question
blank cell causing error in vba
Replies
1
Views
326
WindowGuy
W
W
  • Question Question
multiple password protected pages with same password and using macros
Replies
0
Views
621
WindowGuy
W
O
  • Question Question
Somewhat basic UDFs work except that they return #VALUE! error after hiding rows with VBA.
Replies
2
Views
111
OaklandJim
O
N
  • Question Question
Hiding/showing rows between two values
Replies
1
Views
435
Joe4
Joe4
J
  • Question Question
VBA Macro for hiding and unhiding rows is rearranging cells
2
Replies
14
Views
1K
dmt32
D

Forum statistics

Threads
1,223,893
Messages
6,175,246
Members
452,623
Latest member
cliftonhandyman

Share this page

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
Back
Top