Why does a worksheet copy take so long?

[B540Glenn]

I created a VBA to generate multiple monthly reports. This VBA copies worksheets from four source files to a skeleton file and generates reports from the skeleton. The skeleton file contains report templates and the VBA to populate the templates for a facility or for the facilities combined. When other users from multiple sites run the program, it executes in 45-60 seconds. When I run it (same file in same location), it takes almost 5 minutes. There must be something different about my machine.

I found the delay in processing to be this Statement:

Workbooks(CurrFile).Sheets(FacilityName).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)

I open a source file then copy a worksheet from the source to the skeleton file. I do this 4 times. Each copy takes about a minute.

When I run the VBA in Safe Mode, it runs quickly, 40-50 seconds. This led me to believe that an add-in contributed to the poor performance. I removed ALL the add-ins. Without any add-ins, in regular mode, the VBA still takes 5 minutes to run, in safe mode without add-ins, 40-50 seconds.

What is interfering with the worksheet copy on my machine?
Where else can I look to remove the obstacle?
Got any suggestions?

Thanks for your help,
Glenn

 

[AlphaFrog]

Try suspending Screen updates, Events, and Calculations while copying the sheets.

    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    Application.EnableEvents = [COLOR=darkblue]False[/COLOR]
    Application.Calculation = xlCalculationManual
    
        [COLOR=green]'Copy all sheets here[/COLOR]
        
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = [COLOR=darkblue]True[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]

 

[Redwolfx]

If there are Calculations happening that may be causeing some of the issue. At the beginning of the code try adding

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlcalculationmanual

Then at the end add

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlcalculationautomatic


Alpha got to it first.

 

[B540Glenn]

Thank you for the suggestion but I have these set already. The options I set at the beginning of the script are:

    Application.ScreenUpdating = False
' \/ Test only \/
'    Application.ScreenUpdating = True
' /\ Test only /\
    Application.Calculation = xlManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False

The source files are open ReadOnly because more than 1 user can run the report at a time.
I open files for Current month actual, Previous Month actual, Current month budget and Previous month budget.

The full process I use to copy the sheets after opening the source files is:

    For i = 1 To NumberOfHospitals
        Hospname = Hosparray(i)
        CurrSheet = Hospname & " Curr"
        BudSheet = Hospname & " Bud"
        PrevSheet = Hospname & " Prev"
        PBudSheet = Hospname & " PBud"
        Windows(CurrFile).Activate
        Workbooks(CurrFile).Sheets(Hospname).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)
        Workbooks(Skeleton).Sheets(Hospname).Name = CurrSheet
...

Is there a Windows setting or service or MS Office setting that can interfere with this process? I'm running Excel 2007 in Windows XP sp3. Everyone else is running Excel 2007 or 2010 in XP also but their reports run quickly.

Thanks,
Glenn

 

[Redwolfx]

Sounds strange, but I know there was once an issue that macros ran slower when page breaks were showing. Try Turning them off?

 

[AlphaFrog]

Can you post the code for the whole procedure?

 

[B540Glenn]

Sounds strange, but I know there was once an issue that macros ran slower when page breaks were showing. Try Turning them off?

This sounds plausible because it would explain why it takes so long to run it for me while the other users have no issues. But alas, no page breaks are showing.

I will examine my Options more carefully though.

Thanks,
G

 

[B540Glenn]

Can you post the code for the whole procedure?

If you think it will help... Remember, everybody else who runs this does NOT experience the long run time that I do.

The following is the code for the main module that calls other procedures that actually create the reports. The report creation runs just fine. It's the copying of the worksheets to the skeleton (code in red) that is taking all the time.

Option Explicit
Option Base 1

' Declare Global Variables
Global BaseInputFile As String
Global BaseOutputPath As String
Global BudFile As String
Global BudSheet As String
Global CreateOutputFiles As String
Global CurrFile As String
Global CurrFYFolder As String
Global CurrHosp As String
Global CurrMonth As String
Global CurrMonthYear As String
Global CurrSheet As String
Global DefaultOPFileName As String
Global DefaultOPPath As String
Global FromCol As String
Global HeaderDate As String
Global Hospname As String
Global i As Integer
Global KPISheet As String
Global NumberOfHospitals As Long
Global PBudFile As String
Global PBudSheet As String
Global PrevFile As String
Global PrevFYFolder As String
Global PrevMonth As String
Global PrevMonthYear As String
Global PrevSheet As String
Global ReviewSheet As String
Global SelfPayIP As Single
Global SelfPayOP As Single
Global SheetName As String
Global ShowYourWork As String
Global Skeleton As String
Global SourceFolder As String
Global TimeStampVal As String
Global ToCol As String
    
    
Sub BuildReports()

' Declare local Variables

Dim Hosparray
Dim Response As Long
Dim NewWB As Workbook
Dim OPFileName As Variant
Dim SuggestedFile As String
Dim SaveFilter As Variant

Dim StartTime As Date
Dim EndTime As Date

StartTime = Now()


    Application.ScreenUpdating = False
' \/ test only \/
'    Application.ScreenUpdating = True
' /\ test only /\
    Application.Calculation = xlManual
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    
    Call ResetSkeleton
    Call UnhideSheets
    Call SetVariables
    
    If CreateOutputFiles = "N" Then
        If UCase(ActiveSheet.Range("F1").Value) = "" Then
            ShowYourWork = "No"
        Else
            ShowYourWork = "Yes"
        End If
    Else
        ShowYourWork = "No"
    End If
    
' Start the processing
    If CurrHosp = "All" Then
        NumberOfHospitals = 12
        Hosparray = Array("Hosp01", "Hosp02", "Hosp03", "Hosp04", "Hosp05", "Hosp06", "Hosp07", "Hosp08", "Hosp09", "Hosp10", "Hosp11", "Hosp12")
    Else
        NumberOfHospitals = 1
        Hosparray = Array(CurrHosp)
    End If

' Bring in current and previous data
    Application.StatusBar = "Open Current"
    Workbooks.Open Filename:=SourceFolder & CurrFYFolder & CurrFile, ReadOnly:=True
    Application.StatusBar = "Open Budget"
    Workbooks.Open Filename:=SourceFolder & CurrFYFolder & BudFile, ReadOnly:=True
    Application.StatusBar = "Open Prior"
    Workbooks.Open Filename:=SourceFolder & PrevFYFolder & PrevFile, ReadOnly:=True
    Application.StatusBar = "Open Prior Budget"
    Workbooks.Open Filename:=SourceFolder & PrevFYFolder & PBudFile, ReadOnly:=True
    For i = 1 To NumberOfHospitals
        Hospname = Hosparray(i)
        CurrSheet = Hospname & " Curr"
        BudSheet = Hospname & " Bud"
        PrevSheet = Hospname & " Prev"
        PBudSheet = Hospname & " PBud"
[COLOR=#ff0000]        Windows(CurrFile).Activate
        Workbooks(CurrFile).Sheets(Hospname).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)
        Workbooks(Skeleton).Sheets(Hospname).Name = CurrSheet
        Windows(BudFile).Activate
        Workbooks(BudFile).Sheets(Hospname).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)
        Workbooks(Skeleton).Sheets(Hospname).Name = BudSheet
        Windows(PrevFile).Activate
        Workbooks(PrevFile).Sheets(Hospname).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)
        Workbooks(Skeleton).Sheets(Hospname).Name = PrevSheet
        Windows(PBudFile).Activate
        Workbooks(PBudFile).Sheets(Hospname).Copy After:=Workbooks(Skeleton).Sheets(Workbooks(Skeleton).Sheets.Count)
        Workbooks(Skeleton).Sheets(Hospname).Name = PBudSheet[/COLOR]
        Call BuildKPI
        KPISheet = Hospname & " KPI"
        Call BuildReview
        ReviewSheet = Hospname & " Review"
        Call BuildMTDSummary
        Call BuildYTDSummary
    Next i
    Application.DisplayAlerts = False
    Workbooks(CurrFile).Close SaveChanges:=False
    Workbooks(BudFile).Close SaveChanges:=False
    Workbooks(PrevFile).Close SaveChanges:=False
    Workbooks(PBudFile).Close SaveChanges:=False
    
    If CurrHosp = "All" Then
        Call BuildCorpSummary
        Workbooks(Skeleton).Sheets("Corporate Summary").Select
    Else
        Workbooks(Skeleton).Sheets(CurrHosp & " KPI").Select
    End If

' Exit housekeeping
' \/
    Application.StatusBar = "Calculating"
    Calculate

' Remove the source tabs
    If ShowYourWork = "No" Then
        For i = 1 To NumberOfHospitals
            Hospname = Hosparray(i) & " Curr"
            Workbooks(Skeleton).Sheets(Hospname).Delete
            Hospname = Hosparray(i) & " Bud"
            Workbooks(Skeleton).Sheets(Hospname).Delete
            Hospname = Hosparray(i) & " Prev"
            Workbooks(Skeleton).Sheets(Hospname).Delete
            Hospname = Hosparray(i) & " PBud"
            Workbooks(Skeleton).Sheets(Hospname).Delete
        Next i
    End If

' Create the output file
    If CreateOutputFiles = "Y" Then
        If CurrHosp = "All" Then
            SuggestedFile = DefaultOPPath & "\Corp " & CurrMonth & " " & CurrMonthYear & TimeStampVal & ".xlsx"
        Else
            SuggestedFile = DefaultOPPath & "\" & CurrHosp & " KPI " & CurrMonth & " " & CurrMonthYear & TimeStampVal & ".xlsx"
        End If
        
        SaveFilter = "Excel Workbook (*.xlsx), *.xlsx"
        OPFileName = Application.GetSaveAsFilename(InitialFileName:=SuggestedFile, _
                    fileFilter:=SaveFilter)
        If OPFileName = False Then
            MsgBox "File WILL NOT Save. User cancelled the Save."
        Else
            Application.StatusBar = "Creating Output Files"

            Application.Workbooks.Add
            Set NewWB = ActiveWorkbook
            
            For i = 1 To NumberOfHospitals
                Windows(Skeleton).Activate
                Sheets(Hosparray(i) & " KPI").Select
                Sheets(Hosparray(i) & " KPI").Copy After:=Workbooks(NewWB.Name).Sheets(Workbooks(NewWB.Name).Sheets.Count)
                Windows(Skeleton).Activate
                Sheets(Hosparray(i) & " Review").Select
                Sheets(Hosparray(i) & " Review").Copy After:=Workbooks(NewWB.Name).Sheets(Workbooks(NewWB.Name).Sheets.Count)
                Windows(Skeleton).Activate
                Sheets(Hosparray(i) & " NPSR-MTD Summary").Select
                Sheets(Hosparray(i) & " NPSR-MTD Summary").Copy After:=Workbooks(NewWB.Name).Sheets(Workbooks(NewWB.Name).Sheets.Count)
                Windows(Skeleton).Activate
                Sheets(Hosparray(i) & " NPSR-YTD Summary").Select
                Sheets(Hosparray(i) & " NPSR-YTD Summary").Copy After:=Workbooks(NewWB.Name).Sheets(Workbooks(NewWB.Name).Sheets.Count)
            Next i
            If CurrHosp = "All" Then
                Windows(Skeleton).Activate
                Sheets("Corporate Summary").Select
                Sheets("Corporate Summary").Copy Before:=Workbooks(NewWB.Name).Sheets(1)
                Windows(NewWB.Name).Activate
            End If
            Windows(NewWB.Name).Activate
            Sheets("Sheet1").Delete
            
            Application.StatusBar = "Saving"
            NewWB.SaveAs Filename:=OPFileName, FileFormat:=xlWorkbookDefault
            Windows(NewWB.Name).Close
        End If
    End If
    
    Windows(Skeleton).Activate
    Call HideSheets
    
    Application.StatusBar = False
    Application.EnableEvents = True
    Application.DisplayAlerts = True
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True

EndTime = Now()
MsgBox (StartTime & " - " & EndTime)

' /\
' Exit housekeeping

End Sub

Thanks for taking the time...
Glenn

 

[B540Glenn]

Just a late thought...

Since the poor performance is limited to my execution of the program, could there be something in my Personal.xlsb file that is interfering with the copy?

If so, what could it be? I have a few utility macros in there but why would they affect the performance of specific statements another VBA macro?

G.

 

[B540Glenn]

It's nothing in Personal.xlsb. I removed the file from its folder so Excel couldn't reference it and the results were no different.

Any other ideas?