Managing book of Excel sheets

Question

This is a follow-on from a previous question I posted here.

I've got code here that works for what I want, but the problem is the loop takes ages to perform. I was wondering if anyone could follow this and tidy it up a bit for me.

Sub Refresh_Data()
    Application.CutCopyMode = False

    'Turns screen updating off to increase speed
    Application.ScreenUpdating = False

    'Get 'G/L Account numbers
    Sheet1 = "BW TB"

    Sheets(Sheet1).Activate
    Range("A1").Activate

    'Find last row - always named "Overall Result" in ColA
    Cells.Find(What:="Overall Result", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
    :=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _
    True, SearchFormat:=False).Activate

    'This looks up to row 25 (title row), but adjusts to only copy data from row 26 down to the penultimate row (the subtotal is not required)
    lastrow = Selection.Row - 1
    colno = Selection.Column
    firstrow = Selection.End(xlUp).Row + 1

    'CopyPaste loop

    'First sheet is titled "4020"
    i = Sheets("4020").Index


    'Due to all the sheet names being numeric. This is a slight workaround.
    'It basically runs the macro starting at the 4020 sheet and ending at the last sheet with a numeric sheets.
    'i.e. pastes values for all numbered tabs.
    Do While IsNumeric(Sheets(i).Name) = True

    'clear all formulae except first formulaic row (Row5)
    Sheets(i).Activate
    Range("A6").EntireRow.Select
    Range(Selection, Selection.Offset(1000, 0)).ClearContents


    'Copy G/L Account numbers from BW TB sheet to current sheet
    Sheets(BWTB).Activate
    Range(Cells(firstrow, colno), Cells(lastrow, colno)).Copy

    Sheets(i).Activate
    Range("a5").PasteSpecial xlPasteValues

    'Copy down formulae
    Range("B5:L5").Copy
    Range("B5:L5", Range("B5:L5").Offset(lastrow - firstrow, 0)).PasteSpecial xlPasteFormulas

    ActiveSheet.Calculate

    'Paste As Values
    Range("B6:L6", Range("B6:L6").Offset(lastrow - firstrow, 0)).Copy
    Range("B6").PasteSpecial xlPasteValues

    i = i + 1
    Loop
End Sub

The scenario is about 25 'numericlly named' sheets (eg 4020) for which I need to first clear (this is for a rolling document updated periodically with a differing number of rows required, the determine the number of rows, then copy-pastespecial data from an unformatted mastersheet (BW TB).

Apologies for the mess it's in. I'm in the process of breaking up the code into more sub functions for easier reading.

Answer 1

You should clean up every Select and Activate and use objects instead

You'd better use the object model of VBA.
For instance, if you only want to copy the value of a cell:

Don't do

Range("A1").Select
Selection.Copy
Range("A2").Select
Selection.Paste

Do

Range("A2").Value = Range("A1").Value

Another example:

Don't do

Cells.Find(...).Activate
lastrow = Selection.Row - 1
colno = Selection.Column
firstrow = Selection.End(xlUp).Row + 1

Do

Dim mycell as Range
Set cell = Cells.Find(...)
lastrow = mycell .Row - 1
colno = mycell .Column
firstrow = mycell .End(xlUp).Row + 1

And so on, especially on your Sheet objects.

Example to copy-paste between sheets

You only have to adapt this kind of statement to your specific case:

Worksheets("Sheet1").Range("A1").Copy
Worksheets("Sheet2").Range("A2").PasteSpecial xlPasteFormulas

Other tips

You can also have a look at the very good website of Chip Pearson

Edit

Instead of:

Sheets(i).Activate
Range("A6").EntireRow.Select
Range(Selection, Selection.Offset(1000, 0)).ClearContents

You can try:

Dim lastCol as Long
With Sheets(i)
    lastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
    .Range("A6", .Cells(1000, lastCol)).ClearContents
End With

This will find the last column where you have data (so that you don't have to clear contents of the entire row) on the 6th row and then it will clear the content of the Range between A6 and the last column and the 1000th row.

Another edit

You also have a minor issue in your declaration part.

This:

Dim mycell As Range, LastRow, ColNo, FirstRow, i As Integer

doesn't work, you have to do:

Dim mycell As Range, LastRow As Integer, ColNo As Integer, FirstRow As Integer, i As Integer

Answer 2

First, since you have a ActiveSheet.Calculate, did you turn calculation Off before running the macro ? This might be the easiest and biggest improvement.

Second you can replace:

'clear all formulae except first formulaic row (Row5)
Sheets(i).Activate
Range("A6").EntireRow.Select
Range(Selection, Selection.Offset(1000, 0)).ClearContents

by:

sheets(i).range(6:1006).clearcontents

Third, you could replace:

'Copy G/L Account numbers from BW TB sheet to current sheet
Sheets(BWTB).Activate
Range(Cells(firstrow, colno), Cells(lastrow, colno)).Copy

Sheets(i).Activate
Range("a5").PasteSpecial xlPasteValues

by:

'Copy G/L Account numbers from BW TB sheet to current sheet
with Sheets(BWTB)
   Range(.Cells(firstrow, colno), .Cells(lastrow, colno)).Copy
end with
Sheets(i).Range("a5").PasteSpecial xlPasteValues

Answer 3

This may be solved by disabling Screen Update while the code is running.

1. Add the following line of code just after Sub Refresh_Data()

   Application.ScreenUpdating = False
   

2. Add the following code just before End Sub (Add just before End Sub not in loop)

   Application.ScreenUpdating = True
   

3. Remove the line ActiveSheet.Calculate

This may help. Have a try.

Answer 4

Introduction

The other answers have merit but perhaps not as much merit as the posters think.

I have had the problem of a routine taking much, much longer than expected for no obvious reason on a number of occasions. I would change things around and the problem would disappear but it was never clear what I had done to fix the problem. My best theory was it was something to do with moving rows from one worksheet to another. I promised myself that one day I would investigate this systematically. Chris's problem seemed relatively clean so perhaps this was the opportunity I was seeking.

Summary

With one exception, bad practice in the way worksheets are accessed adds little to the duration of a macro.

Compilation (top option on Debug) has no obvious effect on duration.

Closing and reopening a workbook may reduce the duration of a macro if the workbook has been subject to significant modification since it was last opened.

Even if there are no formulae, having calculation off decreases the duration of a worksheet-accessing macro but not by as much as you would think.

The one bad practice I found that makes a real difference is to switch worksheets and then activate the new worksheet while screen updating is on. By making every other mistake I was able to get the duration of a macro up from 15 to 199 seconds. Adding activate for every access of a new worksheet increased the duration to 9,838 seconds (2:43:58). Adding ScreenUpdating=False brought it down to 466 seconds (7:46)

I suspect that there is a bug in Excel 2003. I have little experience with other versions so it may or may not apply to them. The bug seems to be associated with moving lots of data around and lengthy macro developments with lots of repeated runs to test corrections. I hit this bug once during the experimentation for this answer but as soon as I tried to pin it down it disappeared.

Experiments

I created a workbook with 26 worksheets. One I named "Alpha" while the rest had numeric names. I coded a macro to fill these sheets with between 900 and 1000 rows each of 25 columns with every cell containing a six character string. Other routines cleared rows with either EntireRow.ClearContents and EntireRow.Delete and used Copy and Paste to move data from the worksheet Alpha to the other worksheets.

I could discover no difference in duration between EntireRow.ClearContents and EntireRow.Delete. However clearing or deleting a selected range as opposed to the entire worksheet increased the total duration of processing the 26 worksheets from .07 seconds to .13 seconds.

By including every bad practice I could think of, I could bring the duration of a copy and paste from worksheet Alpha to each of the other 25 worksheets up to 1.3 seconds.

Copying a row 5 containing formulae down from rows 6 to 905 for each of 25 sheets with both Calculate and ScreenUpdating On took 2.5 seconds.

The above are not exact matches for Chris’s routine but they are broadly similar.

The only routine I could get to take more than a second or two was the fill routine. This routine serves to prepare the worksheets for the real tests but it was the only routine that could be made to exhibit extended durations.

The basic function of the fill routine is to fill 26 worksheets with 6 character strings. Every worksheet had 25 columns but the number of rows varies from 900 to 1000. A total of 613,600 cells are filled. For each cell I take the first six characters of a 62-character string and then moved the first character of the 62-character string to the end. To give a crude indication of progress I display the worksheet number to the immediate window. It took two or three seconds per sheet but I did not care enough to improve it.

Using the fill routine to prepare the workbook, I was able to get timings for moving static data about. It was when I updated the fill routine to output formulae to row 5 that I hit a problem. Previously, as the routine ran the numbers 1 to 26 scrolled quickly up the immediate windows. After the update, 1 was displayed and then nothing. I paused the macro after a while and found it had only reached row 177 of the first sheet.

I added a timer to the fill routine and tried to pin down the cause of the slow running but I was never able get it to repeat. This matches my earlier experience of this problem. My macro would suddenly speed up but I was never able to identify anything I had done that caused it to speed up.

As I created routines that took longer to run, I found timings inconsistent. The second run of a macro would take less time than the first. After saving and reopening, the macro would be even quicker. Normally; sometimes it was the other way round. It is possible that background tasks (for example, software checking for updates or virus checker) were a factor but this seems unlikely. The difference in run times was only 10 to 20 seconds but there was no pattern I could detect. Compilation had no noticable effect. I have no difficulty in believing that I was piling up work for the garbage collector; was this a factor? Was Excel losing memory so the heap was getting smaller and smaller? If this was the cause, how come my recollection is that sometimes the slow running would last for a day or two. I usually hibernate Windows but I close Excel down at least once a day during an extended development. I am sorry if this is a brain dump but I am hoping something will click with someone familiar with Excel's internal workings.

I recoded by fill routine to maximise its sensitivity to poor programming. I changed the sequence of the For-loops to: Row, Column, Worksheet. I prefilled the sheet with 562,224 formulae most of which I overwrote one by one. I alternated between activating or not activating the worksheet over 600,000 times, having calculation on or off and having screen updating on or off. The timings I got were:

Activate   Calculation  Screen updating   Total duration
   No        Off          Off               0:00:20
   No        On           Off               0:01:57
   No        On           On                0:03:19
   Yes       Off          Off               0:05:42
   Yes       On           Off               0:07:46
   Yes       On           On                2:43:58        

I ran these tests in background because I could not handle the screen flashing from one sheet to another. I am very impressed at how quickly the fill took without activation, calculation and screen updating since I am generating 613,000 strings and placing them in individual cells. There is clearly an advantage in not activating worksheets and having calculation off if possible but nothing like the advantage I have always assumed.

I should perhaps report that the formulae I used were of the form ‘=Mid($Ax,y,1)’. That is column A contained a string and all the other columns extracted a character from it. I originally set row 4 to numbers and all the other cells to the cell above plus one. I found Mid was noticeable slower. No doubt there are other formulae are even slower.

Conclusions

It is not easy to get extended run times through poor programming; you must make a lot of mistakes at the same time.

Does anyone else recall macros with unexpectedly had extended run times? Can anyone suggest an alternative to my theory that Excel 2003 has a bug that might apply to later versions? I have access to a laptop with Excel 2007 and I with rerun the tests on the laptop when I get the opportunity. However, this is unlikely to reveal the bug, if it exists, because there will be no development which seems to be a requirement.

Answer 5

You will know from my last answer that I have created a workbook that has the same structure as yours. This means that with some modification I can run your macro. For me it takes .75 seconds for the loops to complete. In this answer, I explain what I have done and why.

I recall that at one stage you were reporting that Sheet("BW TB") was being updated when it should not have been. I cannot find that report so perhaps it has been sorted. No matter, it is an excuse to tell you something.

Programs always seem to go wrong in the middle. You want the program to run for 5 minutes and then stop at the problem area so you can investigate statement by statement. The tool for this task is the Assert statement. Most languages have assert statements. The VBA one is of the form:

Debug.Assert Sheets(i).Name <> BWTB

That is Debug.Assert followed by a boolean expression. Here I assert that the current sheet name is not BWTB. It this assertion is true, execution does not pause. But if it is false, execution stops on the assert statement. Place the assert statement at the top of the suspect code. When it pauses, use F8 (execute single statement) or use F9 (set/unset breakpoint) and F5 (execute until breakpoint) to step through the code until you have isolated the problem.

I assume you have made all the improvements people have suggested although my experiments reveal these improvements will not make the difference we all believed.

You start with Sheets("4020"). I seem to recall that you said it was important to start with this sheet. Is this because the other sheets depend on Sheets("4020") or because Sheets("4020") is Sheets(1)? I do not like the way you step through the sheets. Your code depends on Sheets("4020") being Sheets(1) and Sheets("BW TB") being Sheets(26).

If Sheets("4020") is special you should make the body a subroutine with sheet name or index as a parameter. You then (1) call the subroutine for Sheets("4020") and (2) amend the loop to:

For i = 1 to Worksheets.Count
  If (Sheets(i).Name = "4020" or Sheets(i).Name = "BW TB") Then
    ' Do not action this sheet
  Else
    ' Action this sheet
  End if
Next

You could rearrange the boolean expression so the then-block is executed rather than the else-block but that sort of boolean expression hurts my head. If having a boolean expression I can understand means using the else-block then so be it.

When I set up my workbook, my equivalent of Sheets("BW TB") ended up in the middle so I have had to change your code in this way. I have had to do the same to the code I am about to show you.

You need to isolate the portion of your routine that is taking a long time. The secret to this is the Timer statement which returns seconds since midnight as a single.

I have declared some new variables:

  Dim Duration As Single
  Dim InxTVCol As Integer
  Dim InxTVRow As Integer
  Dim TimerVal(1 To 6, 0 To 27) As Single
  Const LastTimeRow As Integer = 26
  Const TotalRow As Integer = 27
  Const LastTimeCol As Integer = 5
  Const TotalCol As Integer = 6

I store timer values in TimerVal(1 To 5, 1 To 26). That is 5 times per loop for each of 26 worksheets. I use column 6 for worksheet totals. I use row 27 for loop portion totals. I used TimerVal(0,5) for the start time so TimerVal(N-1,5) is always the end time of the last loop. I use constants so if you decide you need 4 or 6 times per loop or you add more worksheets, you can change the constants rather than my code

I placed TimerVal(LastTimeCol, 0) = Timer before the Do statment.

I placed TimerVal(1, i) = Timer immediately after the Do statment, with four other such statements placed throughout the loop.

The effect of this is for the loop to record 125 times. The following code displays those times to the immediate window as durations:

  For InxTVRow = 1 To LastTimeRow
    If TimerVal(1, InxTVRow) = 0# Then
      ' This sheet not actioned
    Else
      Duration = TimerVal(1, InxTVRow) - TimerVal(LastTimeCol, InxTVRow - 1)
      Debug.Print Right(" " & InxTVRow, 2) & " " & Format(Duration, "00000.00");
      TimerVal(TotalCol, InxTVRow) = Duration
      TimerVal(1, TotalRow) = TimerVal(1, TotalRow) + Duration
      For InxTVCol = 2 To LastTimeCol
        Duration = TimerVal(InxTVCol, InxTVRow) - TimerVal(InxTVCol - 1, InxTVRow)
        Debug.Print " " & Format(Duration, "00000.00");
        TimerVal(TotalCol, InxTVRow) = TimerVal(TotalCol, InxTVRow) + Duration
        TimerVal(InxTVCol, TotalRow) = TimerVal(InxTVCol, TotalRow) + Duration
      Next
      Debug.Print " | " & Format(TimerVal(TotalCol, InxTVRow), "00000.00")
    End If
  Next
  Debug.Print "  ";
  For InxTVCol = 1 To 5
    Debug.Print " --------";
  Next
  Debug.Print " | ---------"
  Debug.Print "  ";
  Duration = 0#
  For InxTVCol = 1 To 5
    Duration = Duration + TimerVal(InxTVCol, TotalRow)
    Debug.Print " " & Format(TimerVal(InxTVCol, TotalRow), "00000.00");
  Next
  Debug.Print " | " & Format(Duration, "00000.00")

On my system the result is:

 1 00000.00 00000.01 00000.04 00000.01 00000.02 | 00000.07
 2 00000.00 00000.01 00000.03 00000.00 00000.01 | 00000.05
 3 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
 4 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
 5 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
 6 00000.00 00000.00 00000.01 00000.01 00000.00 | 00000.03
 7 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
 8 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
 9 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
10 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
11 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
12 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
13 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
14 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
15 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
16 00000.00 00000.00 00000.01 00000.00 00000.00 | 00000.02
17 00000.00 00000.00 00000.02 00000.00 00000.00 | 00000.03
18 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
19 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
20 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
21 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
22 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
23 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
24 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
25 00000.00 00000.00 00000.01 00000.00 00000.01 | 00000.03
   -------- -------- -------- -------- -------- | ---------
   00000.00 00000.11 00000.34 00000.11 00000.20 | 00000.75

I have an anomaly in portion 3 of sheets 1 and 2 that might bear investigation. I should have displayed sheet name rather than sheet index. I leave that for you.

If the fault is in your code, this should you enable to isolate the cause.