Macro to distribute data within the sheets based on tabs name

Question

I wrote a macro which works, but given the large amount of data, it takes a lot of time. I wonder if there is a way to speed it up. Here is a summary of what it does:

1. In "Summary (All)" tab I have global sheet with all the data.
2. I have several tabs corresponding to the each months.
3. I want to have the data distributed to those tabs, based on the value in one column (should match the tab name).

My code

Option Explicit

Sub CopyDataOutToSheets()
    Dim sh As Worksheet
    Dim SourceSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long
    Dim lrow As Long
    Dim r As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set SourceSh = ActiveWorkbook.Worksheets("Summary (All)")
    Application.DisplayAlerts = False
    On Error Resume Next
    On Error GoTo 0

    For Each sh In ActiveWorkbook.Worksheets
        If IsError(Application.Match(sh.Name, _
                                     Array(SourceSh.Name, "List Data", _
                                     "Lists", "Summary (Filtered)"), 0)) Then
            lrow = lastRow(sh)
            If lrow > 6 Then
                sh.Rows("7:" & lrow).Delete
            End If

            If lastRow(SourceSh) < 7 Then
                MsgBox ("Nothing to move")
                Exit Sub
            End If

            For r = lastRow(SourceSh) To 7 Step -1
                'Finding the first empty row in column A on destination worksheet
                If SourceSh.Range("N" & r).Value = sh.Name Then
                    SourceSh.Rows(r).Copy Destination:= _
                                                  sh.Range("A" & lastRow(sh) + 1)
                End If
            Next r
        End If
    Next

ExitTheSub:
    Application.Goto SourceSh.Cells(1)
    Application.DisplayAlerts = True
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

There are few thousands rows in global tab, so I'm expecting to have roughly 1000 in each tab after distribution. Could you please let me know what would be the best way to make it happen more quickly?

Answer 1

Use any method that make a "directly-interation" with worksheet like copy, paste, range.value = something (...) intensifies the runtime of the code. To solve this you need to create an array to store the SourceSh.Rows(r) values. Before the loop change spreadsheet you parse all values stored in the array to cells using the method that I will show in the example. When the loop change spreadsheet you clear the array.

With that I think that you will have at least 65% better performance.

I created an example comparing runtime of the array method with the single value method, to 20k cells. See the difference?

[

Sub Compare()

Dim arr() As Variant
Dim max As Long
Dim start As Double

start = Timer

max = 20000
ReDim arr(max)

Application.ScreenUpdating = False

'Using the array method

For i = 1 To max

    arr(i) = i

Next i

Sheets("Planilha1").Range("A1:A" & UBound(arr) + 1) = WorksheetFunction.Transpose(arr)
Debug.Print "Array method in seconds: " & Round(Timer - start, 2)


'Parsing single values method

start = Timer

For i = 1 To UBound(arr)

    Sheets("Planilha1").Range("A1:A" & UBound(arr) + 1) = i

Next i

Debug.Print "Value method in seconds: " & Round(Timer - start, 2)


Application.ScreenUpdating = True

End Sub

Answer 2

Maybe Dim SourceSh As Variant and instead of working out of the worksheet, SourceSh will equal your worksheet. By putting the worksheet into an Array (puts it in memory) you will work a ton quicker on all your loops. I had a similar issue a few weeks ago, splitting a master sheet (data draw) into month tabs.

WiseOwl has a good video on Arrays. Here is my post and the answer I received, a lot of solid advice!

Since I am still practicing, I will take a crack at it, update your question with information like an example of the data you are moving, the sheets and anything else that you think is relevant.