简体   繁体   中英

Excel VBA Running Macros on Foreach Loop without Switching Sheets

I have a module on VBA which basically runs a foreach loop for every cell that contains text in a column. The contents of each cell are then copied to another sheet where another function is called upon (DailyGet). The contents generated from the function are the copied back into the original sheet (i generated the code for this by recordings a macros). However, since there are many cells to process in the foreach loop, it is quite time consuming because the macros switches between sheets each time to run. Is there any way to speed up the process?

Sub DailyComposite()

Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B2:B100")

For Each cel In SrchRng

    If cel.Value <> "" Then

        Worksheets("Calculations").Range("B1").Value = cel.Value
        Sheets("Calculations").Select
            Call DailyGet
            Range("D3:Z3").Select
            Application.CutCopyMode = False
            Selection.copy
            Sheets("Summary").Select
            cel.Offset(0, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False

    End If

Next cel

    Sheets("Calculations").Select
    Application.CutCopyMode = False
    Range("A1").Select
    Sheets("Summary").Select
    Range("A1").Select

End Sub

For starters, you can get rid of all the selecting

        Range("D3:Z3").Select
        Application.CutCopyMode = False
        Selection.copy
        Sheets("Summary").Select
        cel.Offset(0, 1).Select
        Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
        xlNone, SkipBlanks:=False, Transpose:=False

Should be:

   Sheets("Calculations").Range("D3:Z3").Copy
   cel.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats

Second, why must you switch to the Calculations sheet before running DailyGet. If the function dailyGet uses ActiveSheet, change it to Sheets("Calculations"). If you do that, you never need to switch sheets.

Third, turn off ScreenUpdating when you start the macro, and turn it back on when done:

Application.ScreenUpdating = False

In general you should always avoid select. Instead try and declare/instantiate your variables as shown. I've commented the code below to explain what is going on. Let me know if you have any questions.

    Option Explicit 'Always use this it helps prevent simple errors like misspelling a variable

Sub DailyComposite()
'Declare all variables you are going to use
Dim wb As Workbook 'The workbook youa re working with
Dim wsCalc As Worksheet 'Calculations sheet
Dim wsSum As Worksheet 'Summary Sheet
Dim SrchRng As Range, cel As Range

'Instantiate your variables
Set wb = ThisWorkbook
Set wsCalc = wb.Worksheets("Calculations")  'now you can simply use the variable to refer to the sheet NO SELECTING
Set wsSum = wb.Worksheets("Summary") 'SAME AS ABOVE
Set SrchRng = Range("B2:B100")

Application.ScreenUpdating = False  'Turn this off to speed up your macro
For Each cel In SrchRng
    If cel.Value <> "" Then
        'This ... Worksheets("Calculations").Range("B1").Value = cel.Value becomes...
        wsCalc.Range("B1").Value = cel.Value
        'Sheets("Calculations").Select ... this line can be deleted
            Call DailyGet

            'Range("D3:Z3").Select
            'Application.CutCopyMode = False
            'Selection.Copy
            'Sheets("Summary").Select
            'cel.Offset(0, 1).Select
        'Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
         '   xlNone, SkipBlanks:=False, Transpose:=False
         'All of the above can be replaced by...
        wsCalc.Range("D3:Z3").Copy
        cel.Offset(0, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
            xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next cel
'You can keep these if you truly want to select the A1 cell at the end
    'Sheets("Calculations").Select
    wsCalc.Activate
    Range("A1").Select
    'Sheets("Summary").Select

    wsSum.Activate
    Range("A1").Select
Application.ScreenUpdating = True 'Turn it back on
End Sub

There is no need to copy and paste values. I select Worksheets("Calculations") to insure that DailyGet will run as before.

Sub DailyComposite()

    Dim SrchRng As Range, cel As Range
    Set SrchRng = Worksheets("Summary").Range("B2:B100")

    With Worksheets("Calculations")
        .Select

        For Each cel In SrchRng

            If cel.Value <> "" Then

                Range("B1").Value = cel.Value

                Call DailyGet

                cel.Offset(0, 1).Resize(, 23).Value = Range("D3:Z3").Value

            End If
        Next cel
    End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM