More efficient sub routine

Question

I have the following code that creates links to a Summary sheet on multiple CS Sheets. The number of CS sheets is generated from one CS master sheet using another code module.The code works but is very slow when creating multiple CS sheets. How could I make it more efficient?

Sub CSrefs()
'
' Adds links from Summary Sheet to CS Sheets:

Dim i As Integer
Dim iOffset As Integer

    intCount = ActiveWorkbook.Sheets.Count      'Find total number of workbook sheets
    intCS1_Index = Sheets("CS1").Index          'CS1 Sheet index
    intCSCount = intCount - (intCS1_Index - 1)  'Find total number of CS sheets
    NonCSSheets = intCount - intCSCount         'Find total number of Non-CS sheets

For i = 1 To intCSCount 'number of sheets

    iOffset = i + NonCSSheets
    Sheets("CS" & i).Select
    Range("B3").Select
        ActiveCell.Formula = "=SUMMARY!E" & iOffset
    Range("A6").Select 'Adds hyperlink to Summery Sheet
        ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet"
    Range("F8").Select
        ActiveCell.Formula = "=SUMMARY!F" & iOffset
    Range("D8").Select
        ActiveCell.Formula = "=SUMMARY!G" & iOffset
    Range("B12").Select
        ActiveCell.Formula = "=SUMMARY!H" & iOffset
    Range("K19").Select
        ActiveCell.Formula = "=SUMMARY!S" & iOffset
    Range("K49").Select
        ActiveCell.Formula = "=SUMMARY!T" & iOffset
    Range("K79").Select
        ActiveCell.Formula = "=SUMMARY!U" & iOffset
    Range("K109").Select
        ActiveCell.Formula = "=SUMMARY!V" & iOffset
    Range("K139").Select
        ActiveCell.Formula = "=SUMMARY!W" & iOffset
    Range("K169").Select
        ActiveCell.Formula = "=SUMMARY!X" & iOffset
    Range("B8").Select

Next i

Sheets("Summary").Select

End Sub

Creating sheets is kind of a slow process, but you don't need all the selects in there, which will help. You should just be able to use Range("X#").Formula = "SUMMARY!X" & iOffset. That might cut down on processing slightly. Also, if you don't turn screen updating off, that will severely slow things down. Consider book-ending the code with `Application.ScreenUpdating = false ... Application.ScreenUpdating = true` to cut down on refresh rate, which could help quite a bit. — tmoore82, Sep 17 '14 at 13:29
Since Excel 2007 worksheets have the capacity for 1,048,576 rows so I would add that it is good practise to declare your numeric variables as `Long` and not `Integer`. An integer assigned to `Rows.Count` will generate an overflow. — , Sep 17 '14 at 14:26

xificurC · Answer 1 · 2014-09-17T14:05:23.410

Sub CSrefs()
'
' Adds links from Summary Sheet to CS Sheets:

Dim i As Integer, iOffset As Integer, intCount as Integer
Dim intCS1_Index As Integer, intCSCount as Integer, nonCSSheets as Integer

On Error Goto ErrHandler

Application.ScreenUpdating = False

intCount = ActiveWorkbook.Sheets.Count      'Find total number of workbook sheets
intCS1_Index = Sheets("CS1").Index          'CS1 Sheet index
intCSCount = intCount - (intCS1_Index - 1)  'Find total number of CS sheets
NonCSSheets = intCount - intCSCount         'Find total number of Non-CS sheets

For i = 1 To intCSCount 'number of sheets
    iOffset = i + NonCSSheets
    With Sheets("CS" & i)
        .Range("B3").Formula = "=SUMMARY!E" & iOffset
        .Range("A6").Hyperlinks.Add Anchor:=.Range("A6"), Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet"
        .Range("F8").Formula = "=SUMMARY!F" & iOffset
        .Range("D8").Formula = "=SUMMARY!G" & iOffset
        .Range("B12").Formula = "=SUMMARY!H" & iOffset
        .Range("K19").Formula = "=SUMMARY!S" & iOffset
        .Range("K49").Formula = "=SUMMARY!T" & iOffset
        .Range("K79").Formula = "=SUMMARY!U" & iOffset
        .Range("K109").Formula = "=SUMMARY!V" & iOffset
        .Range("K139").Formula = "=SUMMARY!W" & iOffset
        .Range("K169").Formula = "=SUMMARY!X" & iOffset
    End With
Next i

Sheets("Summary").Select

ExitHere:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    ' take care of errors here if needed
    GoTo ExitHere

End Sub

Untested. I changed a couple of things:

declare all your variables up front (use Option Explicit, set it up in your VBE options)
don't Select stuff, you can work with cells directly
if your code interacts a lot with cells turn off Screenupdating

Good point about `Select`. I always like to link to [this thread](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) which explains how & why :) — David Zemens, Sep 17 '14 at 13:53
I believe that `iOffset = i + NonCSSheets` should be within the `For ... Next` loop. — , Sep 17 '14 at 14:03
Many thanks xificurC the 'With Sheets' section does the trick — Paul_S, Sep 17 '14 at 14:21

score 1 · Answer 2 · answered Sep 17 '14 at 13:34

Stop selecting things - there's no need in vba

instead of

 iOffset = i + NonCSSheets
 Sheets("CS" & i).Select
 Range("B3").Select
    ActiveCell.Formula = "=SUMMARY!E" & iOffset
Range("A6").Select 'Adds hyperlink to Summery Sheet
    ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet"
Range("F8").Select
    ActiveCell.Formula = "=SUMMARY!F" & iOffset

try

   iOffset = i + NonCSSheets
   with sheets("CS" & i)
       range("b3").formula = "=SUMMARY!E" & iOffset
       range("a6").hyperlinks.add Anchor:=Selection, Address:="", SubAddress:="Summary!A" & iOffset, TextToDisplay:="Go to Summary Sheet"
       range("f8").formula = "=SUMMARY!F" & iOffset
   end with

etc

might be missing the prefixing . in the `Range` objects within that `With ... End With` and the `Selection` as the `anchor` in the `hyperlink` should be changed. — , Sep 17 '14 at 13:57

More efficient sub routine

2 Answers2