0

I frequently combine huge worksheets into one for reporting purposes.

I often have trouble with macros running out of memory, refusing to work, locking up the PC etc.

Searching this site I have seen it stated many times that copy/paste is a slower method for shifting around big sets of data.

When I tried these two different approaches however, the copy/paste was faster (I even tried disabling screen updates!)

How is dest = src getting outperformed? I thought because it was avoiding using application level functions it would be quicker. (I also had to put in those Sheet(i).Activate parts to get the range variables to work.)

I tested with 5 worksheets of around 60k rows, and 49 columns. The copy/paste code nailed it in like 30 seconds, while the dest = src seemed to take more like 90 seconds.

Also, I have read about using dynamic Arrays to copy data in this fashion, but I've never gotten it to work.

copy/paste code:

Sub Combine()
    Dim J As Integer
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    Sheets(1).Name = "Combined"
    Sheets(2).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(1).Range("A1")
    For J = 2 To Sheets.Count
        lastRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row
        Sheets(J).Activate
        Range("A1").Select
        Selection.CurrentRegion.Select
        Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
        Selection.Copy Destination:=Sheets(1).Range("A" & lastRow + 1)
    Next
End Sub

dest = src code:

Sub collateSheets()

    Dim ws As Worksheet
    Dim LR As Long, LR2 As Long
    Dim LC As Long
    Dim i As Long
    Dim src As Range
    Dim dest As Range

    startNoUpdates

    Set ws = Worksheets.Add(before:=Sheets(1)) ' place new sheet in first position
    With ws
        .Name = "Collated Data"
        .Range("1:1").Value = Sheets(2).Range("1:1").Value
    End With
    On Error GoTo skip
    For i = 2 To Worksheets.Count ' avoiding "Collated Data"
        With Sheets(i)
            LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        End With
        LR = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        LR2 = Sheets(i).Cells(Sheets(i).Rows.Count, 1).End(xlUp).Row
        Sheets(i).Activate
        Set src = Sheets(i).Range(Cells(2, 1), Cells(LR2, LC))
        Sheets(1).Activate
        Set dest = Sheets(1).Range(Cells(LR + 1, 1), Cells(LR + LR2 - 1, LC))
        dest.Value = src.Value
skip:
    Next

    endNoUpdates

End Sub

Sub startNoUpdates()
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
    .DisplayAlerts = False
End With
End Sub

Sub endNoUpdates()
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
    .DisplayAlerts = True
End With
End Sub

EDIT1:

I tried user10798192's very sophisticated looking code (What is IIf?) and Harassed Dad's improved copy/paste code.

copy/paste - 10.6 Seconds
dest = src - > 120 seconds

So for combining sheets at least, copy/paste seems to be crushing it.

Community
  • 1
  • 1
HotSauceCoconuts
  • 301
  • 5
  • 19
  • 4
    In both case, it would be probably a good idea to not use `.Select` nor `.Activate`. See [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Vincent G Dec 17 '18 at 15:31
  • 1
    You are doing things in a loop that a) only need to be done once outside the loop b) could be avoided by bulk operations that do not use loops. –  Dec 17 '18 at 15:36
  • 1
    Also, if the code works, you may instead want to post this to [CodeReview](https://codereview.stackexchange.com/) – BruceWayne Dec 17 '18 at 15:53

2 Answers2

1
Sub Demo()
 'generic aggregate all sheets into 1 routine
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 On Error GoTo whoops
 Dim ws As Worksheet
 Dim dest As Worksheet
 Dim source As Range
 Dim Target As Range
 Set dest = Worksheets.Add()
 Set Target = dest.Range("a1")
 Worksheets(1).Range("a1").EntireRow.Copy Target
 Set Target = Target.Offset(1, 0)
 For Each ws In Worksheets
     If ws.Index <> 1 Then
        ws.UsedRange.Copy Target
        Set Target = dest.Range("a" & Rows.Count).End(xlUp).Offset(1, 0)
      End If
 Next ws
 whoops:
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
 MsgBox "Done"
 End Sub

I think you might find this approach a bit faster

Harassed Dad
  • 4,669
  • 1
  • 10
  • 12
1
Option Explicit

Sub collateSheets()

    Dim ws As Worksheet, w As Long

    alterEnvironment restore:=False

    Set ws = Worksheets.Add(before:=Sheets(1))
    With ws
        .Name = "Collated Data"
        .Range("1:1").Value = Sheets(2).Range("1:1").Value
    End With

    On Error GoTo skip
    For w = 2 To Worksheets.Count
        With Worksheets(w).Cells(1).CurrentRegion.Offset(1)
            Worksheets(1).Cells(.Rows.Count, "A").End(xlUp). _
                Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
        End With
skip:
    Next w

    alterEnvironment

End Sub

Sub alterEnvironment(Optional restore As Boolean = True)

    Static origCalc As Variant

    With Application
        If IsEmpty(origCalc) Then origCalc = .Calculation
        .Calculation = IIf(restore, origCalc, xlCalculationManual)
        .ScreenUpdating = restore
        .EnableEvents = restore
        .DisplayAlerts = restore
    End With

End Sub
  • this code proved to run much slower with large datasets, I guess it must be something to do with how the active memory is used... way over my head! Your code is really intriguing though I'm gonna have to study it – HotSauceCoconuts Dec 17 '18 at 22:48