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.