4
\$\begingroup\$

Into my workbook I've the db of inventory, in another sheet I've one pvt and in the filter field I put the filed "Card". Now I want create one sheet for each "Card" usually I use this code for this operation:

Sub cmdg2b2(control As IRibbonControl)  'genera una sheets per ogni card
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
    Sheets("pivot").Select
    ActiveSheet.Unprotect
    ActiveSheet.PivotTables("Pvt_Pck").ShowPages PageField:="Card"
    Sheets("pivot").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("pivot").EnableSelection = xlNoSelection
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

This function always runs right, but this year the sheets are much (175) and my code stopped for exceeded memory. I think to hide half off the total sheets, if I hide the sheets manually with pvt filer the operation run in a couple of minutes, if I use this code I need 9 minutes.

Can somebody help me to improve the performance my code?

Function ShowSheets(ByVal conta As String)  'card serves to define whether to show the first half of the sheets or the second
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim tsheet As Integer
Dim tstart As Date, tend As Date, tteempo As Date
tstart = Now()
    ActiveSheet.PivotTables("Pvt_Pck").PivotFields("Card").CurrentPage = "(All)"
    With ActiveSheet.PivotTables("Pvt_Pck").PivotFields("Card")
    tsheet = Int(.PivotItems.Count / 2)
    Select Case conta
    Case "A"
        For i = 1 To tsheet
            .PivotItems(i).Visible = False
        Next i
    Case "B"
        For i = tsheet + 1 To .PivotItems.Count - 1
            .PivotItems(i).Visible = False
        Next i
    End Select
    End With
    Range("A4").Select
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
tend = Now()
ttempo = tend - tstart
Debug.Print ttempo
End Function
\$\endgroup\$
  • \$\begingroup\$ Do have a loop to go through the sheets? \$\endgroup\$ – Raystafarian Feb 11 '16 at 16:49
  • \$\begingroup\$ @Raystafarian why yr question? I' 2 sheets "db" and "pivot" \$\endgroup\$ – Fabrizio Feb 11 '16 at 16:53
  • \$\begingroup\$ You mentioned you have many sheets (175)? \$\endgroup\$ – Raystafarian Feb 11 '16 at 16:54
  • \$\begingroup\$ i mentioned that I want to create 175 sheets, one for inventory card, usually I used the function cmdg2b2, but in this case (175 card) the sys down, then the idea to divide the sheet extraction in two time. But if I unflag the card directly from pivot the refresh run in a few minutes, whit my code ShowSheets, I need more or less 10 minute. \$\endgroup\$ – Fabrizio Feb 11 '16 at 17:06
  • \$\begingroup\$ I'm sorry, I'm having a real difficult time understanding what it is you are doing. So you have inventory, then a sheet with a pivot table and you want to create a sheet for each item on the pivot table? \$\endgroup\$ – Raystafarian Feb 11 '16 at 19:16
2
\$\begingroup\$
Sheets("pivot").Select
ActiveSheet.Unprotect
ActiveSheet.PivotTables("Pvt_Pck").ShowPages PageField:="Card"
Sheets("pivot").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("pivot").EnableSelection = xlNoSelection

This is rather inefficient, and harder to follow than it needs to be. There's no need to Select anything and to work off the ActiveSheet.

Every sheet has a code name, an identifier that you can use in code to refer to it. Think of it as a free object instance living in global scope, waiting to be used. Select the worksheet in the VBE's Project Explorer (Ctrl+R if it's not displayed), and look at its properties (F4 if it's not displayed):

Properties of 'Sheet1'

Notice there are two Name properties: one (Name) is the name of the tab in Excel; the other ((Name)) is the name of that "free object" I'm talking about.

If Sheets("pivot") is named Sheet1, then you can .Select it like this:

Sheet1.Select

But you don't need to do this.

You're accessing the Sheets collection (implicitly ActiveWorkbook.Sheets); that collection contains all sheets, and in Excel not all Sheet objects are a Worksheet - the Sheets collection also contains Chart sheets!

So instead of Sheets("name"), you should be accessing Worksheets("name") if you expect to be working with a worksheet. But you don't need to do that either.

And you should avoid implicit references to the ActiveWorkbook or the ActiveSheet: a fully-qualified ThisWorkbook.Worksheets("name") call is more reliable than Worksheets("name").

But I digress. I was saying you don't need to do this. Let's say you gave your "pivot" sheet a code name, and that you can access it in code with the PivotSheet identifier.

You could then do this:

With PivotSheet
    .Unprotect
    .PivotTables("Pvt_Pck").ShowPages PageField:="Card"
    .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    .EnableSelection = xlNoSelection
End With

This does exactly the same thing as the snippet I quoted at the top of this post. Except if you look under the hood. Your code really did this:

  • In the Sheets collection of the ActiveWorkbook, look for the sheet named "pivot", and Select that sheet (so it becomes the ActiveSheet).
  • Unprotect the active sheet.
  • In the PivotTables collection of the ActiveSheet, look for the pivot table named "Pvt_Pck", and change the PageField to "Card".
  • In the Sheets collection of the ActiveWorkbook, look for the sheet named "pivot", and Protect that sheet.
  • In the Sheets collection of the ActiveWorkbook, look for the sheet named "pivot", and set EnableSelection on that sheet to xlNoSelection.

Notice everytime you access the Sheets collection, you're working much harder than you need to. Compare to mine:

  • Using the PivotSheet object reference...
    • Unprotect it.
    • In the PivotTables collection, look for the pivot table named "Pvt_Pck", and change the PageField to "Card".
    • Protect it.
    • Set EnableSelection to xlNoSelection.

Sub cmdg2b2(control As IRibbonControl)

You should always use names that you can pronounce. cmdg2b2 says nothing more than can be inferred from its IRibbonControl parameter, that it's some Ribbon callback procedure. What does it do? Wouldn't this be easier to work with?

Public Sub SetPivotPageField(ByRef control As IRibbonControl)

The procedure now...

  • has an explicit access modifier (Public)
  • is now explicit about how it's receiving its parameter (ByRef)
  • has a name that starts with a verb, conforms to the PascalCase naming convention of everything else in VBA, and gives us a clue about what's happening in its scope, without having to look at the actual code.

In the ShowSheets method, I can't help but notice these repeated lines:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

You had them in your Ribbon callback procedure too:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Every time you set Application.Calculation to xlCalculationAutomatic, you trigger a recalculation; in a large complicated workbook with lots of lookups and external dependencies, this single instruction alone can take several minutes to complete: don't toggle calculation mode without needing to.

Now, repeating code like this isn't something you want to have all over the place. Make a small procedure for that.

Private Sub ToggleWaitMode(Optional ByVal wait = True, Optional ByVal toggleCalculation = True, Optional ByVal toggleEvents = True)
    With Application
        .StatusBar = IIf(wait, "Please wait...", vbNullString)
        .ScreenUpdating = Not wait
        .EnableEvents = IIf(toggleEvents, Not wait, .EnableEvents)
        .Calculation = IIf(toggleCalcualtion, IIf(wait, xlCalculationManual, xlCalculationAutomatic), .Calculation)
    End With
End Sub

Now instead of copying the same code to toggle these things, you can simply do this before a long-running operation:

ToggleWaitMode

And then this when you're done:

ToggleWaitMode False

Now, seeing "Please wait..." in the status bar for 9 minutes isn't cool at all, and if I'm the user I totally think Excel is frozen. Consider updating progress in the status bar:

Public Sub UpdateStatus(Optional ByVal text As String = vbNullString)
    Dim appScreenUpdating As Boolean
    With Application
        appScreenUpdating = .ScreenUpdating
        If Not appScreenUpdating Then .ScreenUpdating = True
        .StatusBar = text
        .ScreenUpdating = appScreenUpdating
    End With
End Sub

You need this procedure to make sure ScreenUpdating is on before it updates the status bar text, otherwise the user won't see it changing because Excel isn't repainting itself.


These "helper procedures" can now be used to make your code much more focused on what it's supposed to do.

The ShowSheets function isn't returning anything. Function members should have a return value - if you don't need a return value, then make it a Sub (procedure) instead.

ActiveSheet.PivotTables("Pvt_Pck").PivotFields("Card").CurrentPage = "(All)"

You're not activating/selecting any sheet here - the procedure simply assumes that the active sheet has a pivot table named Pvt_Pck... and things could go horribly wrong if that's not the case: with screen updating turned off, and no error handling to turn it back on, things can get messy.

Handle runtime errors!

Public Sub ShowSheets(ByVal conta As String)

    On Error GoTo CleanFail
    ToggleWaitMode

    '...

CleanExit:
    ToggleWaitMode False
    Exit Sub

CleanFail:
    MsgBox Err.Description, vbExclamation
    Resume CleanExit
End Sub

Again, avoid working with the ActiveSheet, be it explicitly or implicitly.

Range("A4").Select

That Range call is an implicit reference to the active sheet - and if that sheet is not a Worksheet object, the Range method will fail, like this:

Run-time error '1004': Application-defined or object-defined error

Not very graceful.


tsheet = Int(.PivotItems.Count / 2)

The Int function may not be working the way you intend it here: it doesn't round anything, it simply cuts the decimal part of the number - so this:

Int(1/2)

Returns 0. It could matter, or not. But it's good to know.


This is annoying:

Select Case conta
Case "A"
    ...
Case "B"
    ...
End Select

You need a comment to explain what the parameter is used for, and then when you call the method you need to know what magic values are being handled. Not cool. Using magic strings or magic numbers is the same thing: you're using magic values.

Make an enum instead:

Public Enum CardDisplayStyle
    ShowTopHalf
    ShowBottomHalf
End Enum

And now instead of passing a magic string "A" or "B", the call site looks like this:

ShowSheets ShowTopHalf

Or:

ShowSheets ShowBottomHalf

And the signature changes to this:

Public Sub ShowSheets(ByVal conta As CardDisplayStyle)

And the Select Case block no longer works off magic strings:

Case ShowTopHalf
    ...
Case ShowBottomHalf
    ...
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.