VBA syntax that compiles sub data into master sheet

Question

I am using this syntax to bring in the names of all employees whom are active, then from there filter the data on subsequent worksheets and use a formula to bring the data over to the All worksheet.

This syntax works, but I am by no means a VBA guru, and would love any ways on optimization to speed this up!

Function GatherData()
    'Declaring variables
    Dim sortValue As String, startdateparam As String, enddateparam As String
    Dim startdateparamyear As String, enddateparamyear As String
    Dim FirstDayOfYear As String, LastDayOfYear As String

    'Setting variables
    startdateparam = "01/01/2016"
    enddateparam = "03/01/2016"

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'If sheet exists deleting it
    On Error Resume Next
    ThisWorkbook.Sheets("All").Delete
    'Adding in an All worksheet
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = "All"
    End With
    'Setting and declaring variables
    Dim copyto As Worksheet: Set copyto = Sheets("All")
    Dim copyfrom As Worksheet: Set copyfrom = Sheets("Data")
    'Filtering the data before copying
    With Sheets("Data")
        With .ListObjects("Data").Range
            .AutoFilter
            .AutoFilter Field:=16, Criteria1:=">=" & CDbl(CDate(startdateparam)), Operator:=xlAnd, Criteria2:=" <= " & CDbl(CDate(enddateparam))
        End With
    End With
    'Copying Distinct Customer Names To The All Worksheet
    copyfrom.Range("A2:A65536").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=copyto.Range("A2"), Unique:=True

    'Removing any duplicates that were copied
    Columns("A:A").Select
    ActiveSheet.Range("$A$1:$A$65536").RemoveDuplicates Columns:=1, Header:=xlNo
    Range("A1").Select

    'Filtering Data before copy
    With Sheets("Data")
        With .ListObjects("Data").Range
            .AutoFilter
            .AutoFilter Field:=16, Criteria1:=">=" & CDbl(CDate(startdateparam)), Operator:=xlAnd, Criteria2:=" <= " & CDbl(CDate(enddateparam))
        End With
    End With

    'Altering variables for new format
    startdateparamyear = Month(startdateparam) & "/" & Day(startdateparam) & "/" & Year(startdateparam) - 1
    enddateparamyear = Month(enddateparam) & "/" & Day(enddateparam) & "/" & Year(enddateparam) - 1
    With Sheets("TR")
        With .ListObjects("TR").Range
            .AutoFilter
            .AutoFilter Field:=5, Criteria1:=">=" & CDbl(CDate(startdateparamyear)), Operator:=xlAnd, Criteria2:=" <= " & CDbl(CDate(enddateparamyear))
        End With
    End With

    'Altering variables for new filter
    FirstDayOfYear = "1/1/" & Year(startdateparam)
    LastDayOfYear = "12/31/" & Year(enddateparam)
    With Sheets("TR")
        With .ListObjects("TR").Range
            .AutoFilter
            .AutoFilter Field:=1, Criteria1:=sortValue
            .AutoFilter Field:=5, Criteria1:=">=" & CDbl(CDate(FirstDayOfYear)), Operator:=xlAnd, Criteria2:=" <= " & CDbl(CDate(LastDayOfYear))
        End With
    End With

    'Updating all sheet with data
    With Sheets("All")
        With .Range("C2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Formula = "=SUMIFS('Data'!C:C,'Data'!A:A,'All Customers'!A2)"
            .Value = .Value
        End With
        With .Range("D2:D" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Formula = "=SUMIFS('Data'!D:D,'Data'!A:A,'All Customers'!A2)"
            .Value = .Value
        End With
        With .Range("E2:E" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Formula = "=SUMIFS('TR'!B:B,'TR'!A:A,'All Customers'!A2)"
            .Value = .Value
        End With
        With .Range("F2:F" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .FormulaR1C1 = "=SUM((RC[-3]+RC[-2])-RC[-1])"
            .Value = .Value
        End With

        'Function To Bring in Additional Data
        CopyMoreData

        'Updating All worksheet Again
        With .Range("J2:J" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .Formula = "=SUMIFS('TR'!B:B,'TR'!A:A,'All Customers'!A2)"
            .Value = .Value
        End With
        With .Range("K2:K" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .FormulaR1C1 = "=IFERROR(SUM((RC[-7]+RC[-6])/RC[-3])/12,0)"
            .Value = .Value
        End With
        With .Range("M2:M" & .Cells(.Rows.Count, "A").End(xlUp).Row)
            .FormulaR1C1 = "=IFERROR(SUM((RC[-7]+RC[-6])/RC[-3]),0)"
            .Value = .Value
        End With

        'Bringing in more data
        NewOrOldCust

        'Bringing in even more data
        GetManager
    End With
End Function
Sub CopyMoreData()

    Dim v As Variant, i As Long, j As Long, arr As Variant
    Dim ws1 As Worksheet: Set ws1 = Sheets("Data")
    Dim ws2 As Worksheet: Set ws2 = Sheets("All")

    v = ws1.Range("A1").CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = 1
        For i = 2 To UBound(v, 1)
            If Not .Exists(v(i, 1)) Then
                .Item(v(i, 1)) = Array(v(i, 7), v(i, 8), v(i, 9))
            Else
                arr = .Item(v(i, 1))
                For j = LBound(arr) To UBound(arr)
                    If arr(j) = 0 Or arr(j) = "" Then
                        If v(i, j + 7) <> 0 And v(i, j + 7) <> "" Then arr(j) = v(i, j + 7)
                    End If
                Next j
                .Item(v(i, 1)) = arr
            End If
        Next i

        Application.ScreenUpdating = False
        ws2.Range("A2").Resize(.Count).Value = Application.Transpose(.Keys)
        i = 2
        For Each itm In .Items
            ws2.Cells(i, 7).Resize(, 3).Value = itm
            i = i + 1
        Next itm
        Application.GoTo ws2.Range("A1")
        Application.ScreenUpdating = True

    End With

End Sub
Public Sub NewOrOldCust()
Const kFml As String = "=IF( ISERROR( MATCH( RC1, #rSrc, 0 ) ), ""No"", ""Yes"" )"
Dim rTrg As Range, rSrc As Range
Dim sFml As String

    With ThisWorkbook.Worksheets("All")
        Set rTrg = .Range("N2:N" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    With ThisWorkbook.Worksheets("NewOrOld")
        Set rSrc = .Range("A1:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    End With

    Rem Reset Formula
    sFml = kFml
    sFml = Replace(sFml, "#rSrc", rSrc.Address(ReferenceStyle:=xlR1C1, External:=1))

    Rem Apply Formula
    With rTrg
        .FormulaR1C1 = sFml
        .Value = .Value2
    End With

End Sub
Public Sub GetManager()

    With ThisWorkbook.Worksheets("All")
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        With .Range("B2:B" & lr)
            .Formula = "=IFERROR(IF(VLOOKUP(A1, 'Data'!A:B, 2, 0)="""","""",VLOOKUP(A1, 'Data'!A:B, 2, 0)),"""")"
            .Value = .Value
        End With
    End With
End Sub

Answer 1

There are many things that you can try to optimize VBA. Look at these links for some insight:

Tips for Optimizing Performance Obstructions

Optimizing VBA

Guide to Improving VBA Performance. Faster Excel VBA

17 ways to Optimize VBA Code for FASTER Macros

Optimize VBA Code to run Macros Faster

Speedy Spreadsheet Week

In short, we can try disabling updating the sheet (calculation, screen, ...), using with blocks, using comma or colon to avoid making new lines, using explicit ranges instead of selection, assigning new ranges instead of editing an existing range, etc. I tried to summarize what has been suggested in the links. See below;

1. In the third link you can find this macro that I am always calling in my Subs:

Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not(isOn)
    Application.ScreenUpdating = Not(isOn)
    ActiveSheet.DisplayPageBreaks = Not(isOn)
End Sub

2. Using With blocks accelerate your process.

3. Selecting ranges is not a really good approach. Almost always, you can avoid selections.

4. When possible, consider using Resize and Offset to create similar ranges Also avoid using Rows.count and xlUp or xlDown as much as possible.

5. While using arrays is a good approach you should consider, if possible, declaring their sizes at the beginning (pre-allocation).

6. Using Option Explicit and declaring each and every variable is another suggestion. It won't speed up your code but will speed up your coding by telling you when, where and what you need to use.

7. Avoid any formatting within VBA as much as you can; however, sometimes it is needed and I would do it myself. Formatting graphs is the worst idea; since complex formatting causes a prompt message which cannot be ignored or even closed by sending keys (consider creating templates and using those).

8. Loops are tricky and can reduce your calculation speed. Avoid loops when possible. Using arrays/ranges would be helpful. For instance:

for i = 1 to n
 mySheet.Cells(i,3) = Some formula
Next i

Can be substituted by:

myRange.formulaR1C1 = Some Formula

9. Creating new files, opening workbooks, reading from the files rather than excel sheets (switching between workbooks), saving workbooks, filtering instead of using formulas when possible, copy/paste instead of assigning a cell/range value, selecting/activating instead of explicitly defining what workbook/worksheet/object you want to work with, etc. are other examples of procedures that would slow down your macro.

10. Using .xlsb instead of .xlsm can sometimes benefit you however it adds an overhead time-cost which needs to be accounted for. Be careful with using that as it may have some other side effects.

11. Try to avoid saving your spreadsheet within VBA if possible.

12. Finally, in reference to this post from StackOverflow, you can use this code to test/measure how much time it takes for your macro or different sections of your code to be done:

time1 = timer()
call Proc1()
time2 = timer()
call Proc2()
time3 = timer()
debug.print "Proc1 time: " & cStr(time2-time1)
debug.print "Proc2 time: " & cStr(time3-time2)