Clearing multiple ranges from multiple worksheets efficiently

[Jon EvanCook]

I have a large worksheet used for creating daily reports on a monthly basis. I am trying to create a macro that will clear the data entries in order to create a blank worksheet that can be used as a template.

The workbook contains a lot of pages but the ones that are currently giving me a problem are the 31 daily entry sheets(one for each day of the month). The sheet codes are Sheet1 through 31, and the sheet names are "1" through "31"

I want to select each sheet, clear the contents of multiple ranges and then in 3 cells I want to insert some text. The code I am currently using is below this clears the multiple ranges but the following 3 lines which add text to 3 cells only work on the first page selected leaving these fields blank on the following 30 pages.

I have tried using a For/Next loop to cycle through the 31 pages but this requires the sheet names to be created as a variable of the loop index, when it selects Sheet1 it actually selects the first sheet in the workbook and not the sheet with the sheetname id = Sheet1 (the tab Name is "1") so this method does not act on the correct sheets.

Is there a more efficient way to clear these ranges and add the three text cells and then park the cursor in cell B8?

'   Clean out all entries in DRS to create a Virgin copy - Screen updating disabled
    Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", _
        "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")).Select
    Range("$B$8:$C$48,$F$8:$O$48,$E$66:$E$72,$C$75:$C$77,$H$66:$H$74,$H$76:$H$77,$C$101:$M$113,$C$115:$M$117,$C$119:$M121,$C$123:$M$127,$U$8:$AM$48").Select
    Selection.ClearContents
    Range("$C$119").Value = "Today:"
    Range("$C$120").Value = "Forecast:"
    Range("$C$121").Value = "Outlook:"

    Range("$B$8").Select

Many thanks
Jon

 

[jolivanes]

Re: That won't 'park the cursor in cell B8' on each sheet as the OP had wanted to do.
I am sorry I missed that important piece of code. My sincere apologies.
If the OP is not able to put that little snippet of code for that in there, he/she can ask for it.

 

[jolivanes]

Sub Clear_Ranges()
Dim i As Long, t, a
a = Array("Today", "Forecast", "Outlook")
t = Timer
Application.ScreenUpdating = False
For i = 1 To 31
With Sheets("" & i & "")
    .Range("$B$8:$C$48,$F$8:$O$48,$E$66:$E$72,$C$75:$C$77,$H$66:$H$74,$H$76:$H$77,$C$101:$M$113,$C$115:$M$117,$C$119:$M121,$C$123:$M$127,$U$8:$AM$48").ClearContents
    .Cells(119, 3).Resize(3).Value = Application.Transpose(a)
    Application.Goto ActiveWorkbook.Sheets("" & i & "").Cells(8, 2)
End With
Next i
Application.ScreenUpdating = True
MsgBox "This macro took " & Format(Round(Timer - t, 2), "00:00:00.00") & " seconds to run."
End Sub

On my machine this took 0.06 seconds. No formulas in the sheets.
If you have lots of formulas, like what Peter alluded to, you might want to use what he suggested in Post #10

Re: If the OP is not able to put that little snippet of code for that in there, he/she can ask for it.
I stand corrected. It was indeed asked for in the first Post.

 

[Peter_SSs]

On my machine this took 0.06 seconds. No formulas in the sheets.

I got similar results, but the code at the bottom of post 7 is about twice as fast for me. Doesn't matter with no formulas but that speed difference could be multiplied with formulas, conditional formatting etc.

 

[Jon EvanCook]

Good points, the sheets contain quite a number of formulae and additionally all the sheets are linked together and to some of the other sheets to provide data tables, I thought I had turned the calculation off but as I wrote the original code some time ago I need to check and verify that I didn't change the calculation status with the new upgraded routines.

 

[Jon EvanCook]

I have rechecked the macro and I had not turned off autocalculation. As mentioned there are quite a lot of formulae lining all the sheets so disabling this to the top of the macro had quite a significant effect. I also put a timer in to check the times using 'Sheets(Array(...' and For/Next with and without autocalculation.

With Autocalc still enabled the For/Next loop took about 17seconds, the Sheets(Array(...)).Select took about 12.5seconds, disabling autocalc had quite a significant effect with the For/Next loop taking about 8seconds and the Sheets(Array(..)) option being slightly faster at 7.8seconds - so close as not to be noticeable.

Many thanks to jolivanes and you for you suggestions.

 

[Peter_SSs]

Cheers, thanks for the follow-up information. Not a lot of difference then so you could choose whichever code you like.

Actually, I would consider adding to either code. Whilst both codes 'park the cursor in B8' now, it may well be that B8 is not in the visible range when you return to the sheet.
I have added some code to my/your code to make cell A1 back at the top left and then select B8 so each sheet is uniform and should have B8 visible and selected when you get to the sheet (unless you have exceptionally wide columns or high rows or big zoom setting )

I also think it is dangerous to leave multiple sheets selected so I have also added code to avoid that (jolivanes' code already did this).

Sub Do_31_Sheets()
  Dim i As Long

  Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", _
        "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")).Select
  Range("$B$8:$C$48,$F$8:$O$48,$E$66:$E$72,$C$75:$C$77,$H$66:$H$74,$H$76:$H$77,$C$101:$M$113,$C$115:$M$117,$C$119:$M121,$C$123:$M$127,$U$8:$AM$48").Select
  Selection.ClearContents
  Range("C119:C121").Select
  Selection.Value = Application.Transpose(Array("Today:", "Forecast:", "Outlook:"))
  Application.ScreenUpdating = False
  For i = 1 To 31
    Application.Goto Sheets(CStr(i)).Range("A1"), True  'Get A1 back to the top left
    Range("$B$8").Select  'Select cell of interest
  Next i
  Sheets("1").Select  '<- I prefer not to leave multiple sheets selected in case data gets accidentally added/removed/altered in multiple sheets
  Application.ScreenUpdating = True
End Sub

If using jolivanes' method then I'd suggest this small change to achieve the same result in terms of how each sheet is presented at the end.

Sub Clear_Ranges()
Dim i As Long, a
a = Array("Today", "Forecast", "Outlook")
t = Timer
Application.ScreenUpdating = False
For i = 1 To 31
With Sheets("" & i & "")
    .Range("$B$8:$C$48,$F$8:$O$48,$E$66:$E$72,$C$75:$C$77,$H$66:$H$74,$H$76:$H$77,$C$101:$M$113,$C$115:$M$117,$C$119:$M121,$C$123:$M$127,$U$8:$AM$48").ClearContents
    .Cells(119, 3).Resize(3).Value = Application.Transpose(a)
    <del>Application.Goto ActiveWorkbook.Sheets("" & i & "").Cells(8, 2)</del>
    Application.Goto .Range("A1"), True
    Range("B8").Select
End With
Next i
Application.ScreenUpdating = True
End Sub

 

[Jon EvanCook]

Thanks Peter,
Good suggestions, I did not add a page selection to clear the grouped sheets because the macro moves to another sheet in the next part of the procedure and finally returns the user to a home page, however the code for straightening up the sheets and getting to the parking spot at "B8" is a handy trick.

Cheers
Jon