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("$A1ドル:$A65536ドル").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)

• user2676140: Good tips, thank you for that! Another thing I have learned from my incessant google searches is that using formulas in VBA is much faster than doing a filter & re-filter every time I need to pull data over.
• M--: @user2676140 anything that avoids from updating the sheet (e.g. selection, filtering, copy/paste) does make vba faster. You can try directly do what you want (e.g. applying on a range, using formulas, transferring values) to speed up the code.