Speeding up run time in VBA excel macro with double loop

Question

I actually have some working code, although with the amount of data I have and the way I wrote the code, it takes upwards of an hour to run, and I still need to add quite a bit of code to actually analyze the data. I'm using a double loop, and before I added the screenupdating = false it seemed like the loop nested on the inside was what was taking so long.

Here's what I have:

Sub LReview()

 Dim SecX As Workbook, LipR As Workbook
 Dim ws As Worksheet, Xws As Worksheet, Fsheet As Worksheet
 Dim i As Long, XwsRows As Long

 Path = ThisWorkbook.Path & "\"

Set LipR = ThisWorkbook
Set SecX = Application.Workbooks.Open(Path & "SecurityXtract_Mnthly.csv")
Windows("SecurityXtract_Mnthly.CSV").Activate
Set Xws = Sheets("SecurityXtract_Mnthly")

With Xws
    XwsRows = .Range("B" & .Rows.Count).End(xlUp).Row
End With

Windows("LMacro.xlsm").Activate
Sheets.Add.Name = "Funds"
Set ws = Sheets("Funds")

    Windows("SecurityXtract_Mnthly.CSV").Activate
        Columns("B:B").Select
    Selection.Copy
    Windows("LMacro.xlsm").Activate
    ws.Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$1:$A$60000").RemoveDuplicates Columns:=1, Header:= _
        xlNo

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    With ws
        'Change back to 100+
        For i = 2 To 5


            If ws.Range("A" & i).Value <> "" Then
            Sheets.Add(After:=Sheets(Worksheets.Count)).Name = ws.Range("A" & i).Value
            Set Fsheet = ActiveSheet
            Range("A1").Value = "Fund:"
            Range("B1").Value = Fsheet.Name
            Range("A2").Value = "Date:"
            Range("B2").Value = "=Xtract!R[-1]C"

            Windows("SecurityXtract_Mnthly.CSV").Activate
            Rows("1:1").Select
            Selection.Copy
            Windows("LMacro.xlsm").Activate
            Rows("4:4").Select
            ActiveSheet.Paste
            Selection.Font.Bold = True
            Application.CutCopyMode = False

            For j = 2 To XwsRows
                If Xws.Range("B" & j).Value = Fsheet.Range("B1") Then
                    Windows("SecurityXtract_Mnthly.CSV").Activate
                    Xws.Range("B" & j).Select
                    ActiveCell.EntireRow.Select
                    Selection.Copy
                    Windows("LMacro.xlsm").Activate
                    Fsheet.Range("A" & j + 3).EntireRow.Select
                    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                    Application.CutCopyMode = False
                    Columns("A:A").Select
                    Selection.SpecialCells(xlCellTypeBlanks).Select
                    Selection.EntireRow.Delete

                End If
            Next j

            Range("C:D, F:F, I:BB, BD:BL, BP:BR, BT:BV, BX:CD, CF:CN, CP:DI").EntireColumn.Select
                    Selection.Delete Shift:=xlToLeft

            End If

                Cells.Select
                Cells.EntireColumn.AutoFit
                Range("A1").Select


        Next i
    End With

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True


 End Sub

I also found this code on another question, but I'm not sure if it can be applied since I'm using two different workbooks. This code:

 If Range("S1").Offset(i) > 0.005 Then
            Range("AC").Offset(i).Resize(1, 2).Value = Range("Z").Offset(i).Resize(1, 2).Value
    End If

Replaced this:

If Range("S" & i) > 0.005 Then
        Range("Z" & i, "AA" & i).Copy
        Range("AC" & i, "AD" & i).PasteSpecial xlPasteValues
End If

The full link of this code/question I reference here is: Suggestions on how to speed up loop

Thanks in advance for any help you can give :)

Jaycal · Accepted Answer · 2013-07-18 19:09:24Z

3

Check out the link on the Excel Blog

Key takeaways from the article that I see in your code:

Avoid Selecting / Activating Objects - In most all cases, the cells or ranges can be directly referenced.

For Example, instead of using
```
ActiveCell.EntireRow.Select
Selection.Copy
```
you can use
```
ActiveCell.EntireRow.Copy
```
Turn Off Everything But the Essentials While Your Code is Running - Even if you don't have tons of calculations in your spreadsheet, I've noticed an improvement when using

Application.Calculation = xlCalculationManual

at the beginning of the code and then at the end, setting it back to (for example) ...

Application.Calculation = xlCalculationAutomatic

Take a look through some of the other tips and examples as well. Hope that helps.

answered Jul 18, 2013 at 19:09

Jaycal

2,0871 gold badge13 silver badges21 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

nemmy Over a year ago

+1 to avoid selecting and activation objects. Reference all ranges/values directly. Don't switch between windows, don't switch between worksheets. Setup initial worksheet object variables and then use these to reference your different worksheets. Also, try switching off the Application.ScreenUpdating setting.

Swolerosis Over a year ago

Thank you both for your help. I'm working through getting rid of the .selects and assigning sheets, but I'm stuck on one. The code I'm trying now is Set Fsheet = LipR.Sheets(Lws.Range("A" & i)) instead of Set Fsheet = ActiveSheet but I'm getting a "Subscript out of Range" error. Any suggestions?

Jaycal Over a year ago

Try updating the workbook reference set as "LipR" to the exactname of the workbook, i.e use Set LipR = Workbooks("NameOfWorkbook") instead of LipR = ActiveWorkbook

Swolerosis Over a year ago

Thanks again! I got everything to work and I shaved the time down by almost 75%!

pgr · Accepted Answer · 2015-01-12 20:19:55Z

If it took more than an hour to run, and you were able to shave off 75%, it still takes a long time to run! If you're still interested in improving, I just want to share that there is a great way to avoid calculation delays. I had fantastic results with this and now I use it all the time.

Simply put, Excel takes a long time copying data back and forth between the "VBA world" and the "spreadsheet world".

If you do all the "reads" at once, process, and then do all the "writes" at once, you get amazing performance. This is done using variant arrays as documented here:

http://msdn.microsoft.com/en-us/library/ff726673.aspx#xlFasterVBA

in the section labeled: Read and Write Large Blocks of Data in a Single Operation

I was able to refactor some code I had that took 5 minutes to run and bring it down to 1.5 minutes. The refactoring took me 10 minutes, which is amazing because it was quite complex code.

Collectives™ on Stack Overflow

Speeding up run time in VBA excel macro with double loop

2 Answers 2

4 Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

4 Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related