Excel 'Big' Data Processing Followup

Question

Previous Question (Initial Level Optimization) : Excel 'big' data processing with vlookups

Code Purpose: Recalculate 25 columns of 500,000 rows each based on new information (provided by a different macro). Before the previous thread it took 28 hours to run, now it takes 8, my goal is under 3.

Notes

• We plan on transferring this process into a program designed to hold this much data, but IT and other specialists are tied up in higher priority projects for the next 7 months. I need to get this running by the end of next month when this type of product goes out again.

• The users have 32 bit Excel and all the restrictions that come with that. I have 64 bit. Currently it takes about a half a Gig to run.

• The report has to be run each morning before 10:00 am which is why my goal is 3 hours. The current run time, 8 hours, is feasible if IT can have it run automatically in the morning, but I have no knowledge of how to implement that kind of process.

• I have been using VBA for less than a year and I have no experience with SQL, or arrays. I know those items might help cut time, but I need some guidance on how to implement them and which direction I should go. I've read a few articles about each so I understand the very basics of how they work and if you can tell me particular functions I should look at and their associated restrictions I would greatly appreciate it.

• The main loop is everything from "For i=2 to lrMain" to the end. The stuff before that runs in about 3 minutes and is not an optimisation concern for me.
• There are no incell computations anywhere in this workbook, so disabling calculations does not result in a time savings.
• Restructuring the raw data is not reasonable at this time, however writing to a new sheet or file is not a problem.
• I greatly appreciate any/all help.

At the top of the module:

Dim velocityLookup As Scripting.Dictionary
Const Velocity_Key_Col As Long = 10
Option Explicit

BuildVelocityLookup Sub built by Comintern

Sub BuildVelocityLookup(target As Worksheet, keyCol As Long, lookup As Scripting.Dictionary)
 Set lookup = New Scripting.Dictionary
 With target
 Dim lastRow As Long
 lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 Dim keys As Variant
 keys = .Range(.Cells(2, keyCol), .Cells(lastRow, keyCol)).Value
 Dim j As Long
 For j = LBound(keys) To UBound(keys)
 'Note that the row is offset from the array.
 keys(j, 1) = UCase(keys(j, 1))
 lookup.Add keys(j, 1), j + 1
 Next
 End With
End Sub

Calculate_Click Written by Emily Alden with improvements from Comintern

Sub Calculate_Click()
'******************* Insert a line to freeze screen here.
 Dim wsMain As Worksheet
 Dim wsQuantity As Worksheet
 Dim wsVelocity As Worksheet
 Dim wsParameters As Worksheet
 Dim wsData As Worksheet
 Dim lrMain As Long 'lr = last row
 Dim lrQuantity As Long
 Dim lrVelocity As Long
 Dim lrParameters As Long
 Dim lrData As Long
 Dim i As Long 'Row Counter
 'For Optimization Testing Only.
 Dim MainTimer As Double
 MainTimer = Timer
 Set wsMain = Worksheets("Main Tab")
 Set wsQuantity = Worksheets("Quantity Available")
 Set wsVelocity = Worksheets("Velocity")
 Set wsParameters = Worksheets("Parameters")
 Set wsData = Worksheets("Data Input by Account")
 lrMain = wsMain.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 lrQuantity = wsQuantity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 lrVelocity = wsVelocity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 lrParameters = wsParameters.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 lrData = wsData.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
 Dim calcWeek As Long
 calcWeek = wsParameters.Range("B3").Value
 For i = 2 To 5 'lrQuantity
 With wsQuantity
 .Cells(i, 5) = .Cells(i, 1) & .Cells(i, 2)
 .Cells(i, 6) = .Cells(i, 1) & UCase(.Cells(i, 2).Value) & .Cells(i, 3)
 End With
 Next i
 wsData.Range(wsData.Cells(2, 1), wsData.Cells(lrData, 4)).Sort _
 key1:=wsData.Range("A2"), order1:=xlAscending, Header:=xlNo
 Dim tempLookup As Variant
 For i = 2 To 5 'lrData
 tempLookup = Application.VLookup(wsData.Cells(i, 2), wsParameters.Range("Table5"), 2, False)
 If IsError(tempLookup) Then
 wsData.Cells(i, 3).Value = "Missing"
 Else
 wsData.Cells(i, 3).Value = tempLookup
 End If
 Next i
 For i = 2 To 5 'lrVelocity
 With wsVelocity
 .Cells(i, 10) = .Cells(i, 1) & .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 9)
 .Cells(i, 10).Value = CStr(Trim(.Cells(i, 10).Value))
 .Cells(i, 11) = .Cells(i, 6)
 .Cells(i, 12) = .Cells(i, 7)
 .Cells(i, 13) = .Cells(i, 8)
 .Cells(i, 14) = .Cells(i, 3)
 .Cells(i, 22) = .Cells(i, 1) & .Cells(i, 9)
 End With
 Next i
 wsVelocity.Range(wsVelocity.Cells(2, 1), wsVelocity.Cells(lrVelocity, 10)).Sort _
 key1:=wsVelocity.Range("J2"), order1:=xlAscending, Header:=xlNo
 BuildVelocityLookup wsVelocity, Velocity_Key_Col, velocityLookup
 Dim indexVelocity1 As Range
 Dim indexVelocity2 As Range
 Dim matchVelocity1 As Range
 Dim matchVelocity2 As Range
 With wsVelocity
 Set indexVelocity1 = .Range(.Cells(2, 7), .Cells(lrVelocity, 7))
 Set indexVelocity2 = .Range(.Cells(2, 3), .Cells(lrVelocity, 3))
 Set matchVelocity1 = .Range(.Cells(2, 1), .Cells(lrVelocity, 1))
 Set matchVelocity2 = .Range(.Cells(2, 22), .Cells(lrVelocity, 22))
 End With
 Dim indexQuantity As Range
 Dim matchQuantity As Range
 With wsQuantity
 Set indexQuantity = .Range(.Cells(2, 4), .Cells(lrQuantity, 4))
 Set matchQuantity = .Range(.Cells(2, 6), .Cells(lrQuantity, 6))
 End With
 Dim ShipMin As Long
 ShipMin = wsParameters.Cells(7, 2).Value
 wsMain.Activate
 With wsMain
 .Range(.Cells(2, 9), .Cells(lrMain, 20)).ClearContents
 .Range(.Cells(2, 22), .Cells(lrMain, 47)).ClearContents
 End With
 For i = 2 To lrMain
 With wsMain
 Dim conUD As String 'con=concatenate
 conUD = .Cells(i, 21) & .Cells(i, 4) & calcWeek
 .Cells(i, 21) = .Cells(i, 5) & .Cells(i, 3)
 If .Cells(i, 8) <> 0 Then
 .Cells(i, 9) = .Cells(i, 6) / .Cells(i, 8)
 End If
 Dim velocityRow As Long
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 11)
 End If
 .Cells(i, 10).Value = tempLookup
 tempLookup = wsVelocity.Cells(velocityRow, 14)
 .Cells(i, 11).Value = tempLookup
 If .Cells(i, 9) > .Cells(i, 11) Then
 .Cells(i, 12).Value = Round((.Cells(i, 6) / .Cells(i, 11)) / .Cells(i, 10), 0.1)
 End If
 If .Cells(i, 6) > 0 Then
 If .Cells(i, 12) <> "" Then
 .Cells(i, 13).Value = .Cells(i, 12) - .Cells(i, 8)
 End If
 End If
 Dim conECD As String
 conECD = .Cells(i, 5) & .Cells(i, 3) & .Cells(i, 4) & calcWeek
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocity.Cells(velocityRow, 12)
 End If
 If .Cells(i, 13) <> "" Then
 If tempLookup <> 0 Then
 .Cells(i, 14).Value = Int(.Cells(i, 13) / tempLookup)
 End If
 End If
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocity.Cells(velocityRow, 13)
 End If
 If .Cells(i, 14) > tempLookup Then
 If .Cells(i, 14) <> "" Then
 .Cells(i, 15).Value = tempLookup
 End If
 Else
 .Cells(i, 15).Value = .Cells(i, 14).Value
 End If
 If .Cells(i, 14) = "" Then
 If .Cells(i, 11) = "" Then
 .Cells(i, 26) = ""
 Else
 .Cells(i, 26).Value = Round(.Cells(i, 14).Value * .Cells(i, 11).Value, 0)
 End If
 End If
 tempLookup = Application.Index(indexQuantity, Application.Match((.Cells(i, 21).Value & "LIBERTY") _
 , matchQuantity, False))
 .Cells(i, 24).Value = tempLookup
 .Cells(i, 18).Value = .Cells(i, 24) - Application.SumIf(.Range(.Cells(1, 21), .Cells(i, 21)), _
 .Cells(i, 21).Value, .Range(.Cells(1, 26), .Cells(i, 26)))
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 13)
 End If
 If .Cells(i, 26) > tempLookup Then
 .Cells(i, 28).Value = tempLookup
 Else
 .Cells(i, 28).Value = .Cells(i, 26).Value
 End If
 If .Cells(i, 18).Value < 0 Then
 .Cells(i, 29).Value = "C"
 .Cells(i, 27).Value = ""
 Else
 .Cells(i, 27) = .Cells(i, 28)
 End If
 .Cells(i, 31).Value = Application.SumIf(.Range(.Cells(2, 1), .Cells(lrMain, 1)), _
 .Cells(i, 1).Value, .Range(.Cells(2, 27), .Cells(lrMain, 27)))
 If .Cells(i, 5) = "" Then
 .Cells(i, 35) = ""
 Else
 .Cells(i, 35).Value = Application.Index(indexVelocity1, _
 Application.Match(.Cells(i, 5), matchVelocity1, False))
 End If
 If .Cells(i, 6).Value = 0 Then
 .Cells(i, 44).Value = 0
 Else
 .Cells(i, 44).Value = Round(((((.Cells(i, 6).Value / .Cells(i, 11).Value) _
 / .Cells(i, 10).Value) - .Cells(i, 8).Value) / .Cells(i, 35).Value), 0.1)
 End If
 If .Cells(i, 6).Value = 0 Then
 .Cells(i, 34).Value = 0
 .Cells(i, 33) = 0
 Else
 .Cells(i, 34).Value = Round(((((.Cells(i, 6) / .Cells(i, 11)) / _
 .Cells(i, 10)) - .Cells(i, 8)) / .Cells(i, 35)) * .Cells(i, 11), 0.1)
 If .Cells(i, 34) > 0 Then
 .Cells(i, 33) = .Cells(i, 34)
 Else
 .Cells(i, 33) = 0
 End If
 End If
 .Cells(i, 37) = 1 + calcWeek
 .Cells(i, 38) = .Cells(i, 5) & .Cells(i, 37)
 .Cells(i, 39).Value = Application.Index(indexVelocity2, _
 Application.Match(.Cells(i, 38), matchVelocity2, False))
 .Cells(i, 40) = Round(((((.Cells(i, 6) / .Cells(i, 11)) * .Cells(i, 39)) _
 - .Cells(i, 6)) - (.Cells(i, 8) - .Cells(i, 6))) / .Cells(i, 35), 0.1)
 If .Cells(i, 40) < 0 Then
 .Cells(i, 41) = 0
 Else
 .Cells(i, 41) = .Cells(i, 40)
 End If
 .Cells(i, 42) = .Cells(i, 41) - .Cells(i, 33)
 If .Cells(i, 11) < .Cells(1, 44) Then
 .Cells(i, 45) = 0
 .Cells(i, 32) = .Cells(i, 45)
 Else
 .Cells(i, 32) = Application.Max(.Cells(i, 33), .Cells(i, 41))
 If .Cells(i, 44) < 0 Then
 .Cells(i, 45) = ""
 Else
 .Cells(i, 45) = .Cells(i, 44)
 End If
 End If
 If .Cells(i, 31) < ShipMin Then
 .Cells(i, 47) = 0
 Else
 .Cells(i, 47) = .Cells(i, 27)
 End If
 .Cells(i, 46) = .Cells(i, 1) & .Cells(i, 22) & .Cells(i, 47)
 End With
 If (i Mod 100) = 0 Then
 Debug.Print "Got to row "; i; " in "; Timer - MainTimer; " seconds."
 End If
 Next i
End Sub

• Brandon Barney: To address your comment about being unfamiliar with arrays, I would recommend experimenting with one in the editor to see how they behave. The easiest way to do this is to declare a variant array, then either ReDim and loop over it, or assign a ListObject.Range.Value (or UsedRange.Value) to it. Unfortunately I dont have any good tutorials on hand, but if you play around with one it should make more sense. In fact, you can think of a 2d array in much the same way as you can think of a spreadsheet. Using an array will be a huge performance increase.
• Brandon Barney: Also, for having IT run it, look into an OnTime event. All you would need to do is have someone have the workbook open and click a button that triggers the ontime event. You can set the time for the macro to run and it will wait until that time to call the routine.
• Emily Alden: @BrandonBarney I've played a little with with arrays, followed along with some tutorials, but they often just scratch the surface of what the arrays are capable of and what their restrictions are. I'll look into the OnTime event. The main issue is that it needs to have new data from the previous evening, but I'll check on what time exactly the new data is available.
• Brandon Barney: for now just think of arrays as tables and worry about getting into their more advanced functions later. As in the answers below, we both treat the array as a table in the same way you manipulate cell references. Once you get comfortable with this functionality you can start using their more advanced functions. For now though, moving away from in-cell manipulation will save you a bunch of processing time.

Answer 1

I tried adapting you code to use an array for this (someone probably beat me to the punch). I commented old code so you could see the logic of what is happening:

Sub Calculate_Click()
'******************* Insert a line to freeze screen here.
Dim wsMain As Worksheet
Dim wsQuantity As Worksheet
Dim wsVelocity As Worksheet
Dim wsParameters As Worksheet
Dim wsData As Worksheet
Dim lrMain As Long 'lr = last row
Dim lrQuantity As Long
Dim lrVelocity As Long
Dim lrParameters As Long
Dim lrData As Long
Dim i As Long 'Row Counter
'For Optimization Testing Only.
Dim MainTimer As Double
MainTimer = Timer
Set wsMain = Worksheets("Main Tab")
Set wsQuantity = Worksheets("Quantity Available")
Set wsVelocity = Worksheets("Velocity")
Set wsParameters = Worksheets("Parameters")
Set wsData = Worksheets("Data Input by Account")
lrMain = wsMain.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
lrQuantity = wsQuantity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
lrVelocity = wsVelocity.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
lrParameters = wsParameters.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
lrData = wsData.Cells.Find(What:="*", SearchOrder:=xlByRows, Searchdirection:=xlPrevious).Row
Dim calcWeek As Long
calcWeek = wsParameters.Range("B3").Value
For i = 2 To 5 'lrQuantity
 With wsQuantity
 .Cells(i, 5) = .Cells(i, 1) & .Cells(i, 2)
 'Removed .Value to keep things consistent
 .Cells(i, 6) = .Cells(i, 1) & UCase(.Cells(i, 2)) & .Cells(i, 3)
 End With
Next i
wsData.Range(wsData.Cells(2, 1), wsData.Cells(lrData, 4)).Sort _
key1:=wsData.Range("A2"), order1:=xlAscending, Header:=xlNo
Dim tempLookup As Variant
For i = 2 To 5 'lrData
 tempLookup = Application.VLookup(wsData.Cells(i, 2), wsParameters.Range("Table5"), 2, False)
 If IsError(tempLookup) Then
 wsData.Cells(i, 3).Value = "Missing"
 Else
 wsData.Cells(i, 3).Value = tempLookup
 End If
Next i
For i = 2 To 5 'lrVelocity
 With wsVelocity
 ' Combined reformatting into one line
 .Cells(i, 10) = CStr(Trim(.Cells(i, 1) & .Cells(i, 4) & .Cells(i, 5) & .Cells(i, 9)))
 .Cells(i, 11) = .Cells(i, 6)
 .Cells(i, 12) = .Cells(i, 7)
 .Cells(i, 13) = .Cells(i, 8)
 .Cells(i, 14) = .Cells(i, 3)
 .Cells(i, 22) = .Cells(i, 1) & .Cells(i, 9)
 End With
Next i
wsVelocity.Range(wsVelocity.Cells(2, 1), wsVelocity.Cells(lrVelocity, 10)).Sort _
key1:=wsVelocity.Range("J2"), order1:=xlAscending, Header:=xlNo
BuildVelocityLookup wsVelocity, Velocity_Key_Col, velocityLookup
Dim indexVelocity1 As Range
Dim indexVelocity2 As Range
Dim matchVelocity1 As Range
Dim matchVelocity2 As Range
With wsVelocity
 Set indexVelocity1 = .Range(.Cells(2, 7), .Cells(lrVelocity, 7))
 Set indexVelocity2 = .Range(.Cells(2, 3), .Cells(lrVelocity, 3))
 Set matchVelocity1 = .Range(.Cells(2, 1), .Cells(lrVelocity, 1))
 Set matchVelocity2 = .Range(.Cells(2, 22), .Cells(lrVelocity, 22))
End With
Dim indexQuantity As Range
Dim matchQuantity As Range
With wsQuantity
 Set indexQuantity = .Range(.Cells(2, 4), .Cells(lrQuantity, 4))
 Set matchQuantity = .Range(.Cells(2, 6), .Cells(lrQuantity, 6))
End With
Dim ShipMin As Long
ShipMin = wsParameters.Cells(7, 2).Value
wsMain.Activate ' Why? No need to activate here.
With wsMain
 .Range(.Cells(2, 9), .Cells(lrMain, 20)).ClearContents
 .Range(.Cells(2, 22), .Cells(lrMain, 47)).ClearContents
End With
Dim arrHolder As Variant
' Check the indices on this. I did my best to assume them using the code.
arrHolder = .Range(wsMain.Cells(2, 1), wsMain.Cells(lrMain, 47))
'For i = 2 To lrMain
' This likely will break cell calculations, but works with the array just fine.
For i = LBound(arrHolder) To lrMain
 With wsMain
 Dim conUD As String 'con=concatenate
 'conUD = .Cells(i, 21) & .Cells(i, 4) & calcWeek
 conUD = arrHolder(i, 21) & arrHolder(i, 4) & calcWeek
 '.Cells(i, 21) = .Cells(i, 5) & .Cells(i, 3)
 arrHolder(i, 21) = arrHolder(i, 5) & arrHolder(i, 3)
 'If .Cells(i, 8) <> 0 Then
 ' .Cells(i, 9) = .Cells(i, 6) / .Cells(i, 8)
 'End If
 If arrHolder(i, 8) <> 0 Then
 arrHolder(i, 9) = arrHolder(i, 6) / arrHolder(i, 8)
 End If
 Dim velocityRow As Long
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 11)
 End If
 '.Cells(i, 10).Value = tempLookup
 arrHolder(i, 10) = tempLookup
 tempLookup = wsVelocity.Cells(velocityRow, 14)
 '.Cells(i, 11).Value = tempLookup
 arrHolder(i, 11) = tempLookup
 'If .Cells(i, 9) > .Cells(i, 11) Then
 ' .Cells(i, 12).Value = Round((.Cells(i, 6) / .Cells(i, 11)) / .Cells(i, 10), 0.1)
 'End If
 If arrHolder(i, 9) > arrHolder(i, 11) Then
 arrHolder(i, 12) = Round((arrHolder(i, 6) / arrHolder(i, 11)) / arrHolder(i, 10), 0.1)
 End If
 'If .Cells(i, 6) > 0 Then
 ' If .Cells(i, 12) <> "" Then
 ' .Cells(i, 13).Value = .Cells(i, 12) - .Cells(i, 8)
 ' End If
 'End If
 If arrHolder(i, 6) > 0 Then
 If arrHolder(i, 12) <> vbNullString Then
 arrHolder(i, 13) = arrHolder(i, 12) - arrHolder(i, 8)
 End If
 End If
 Dim conECD As String
 'conECD = .Cells(i, 5) & .Cells(i, 3) & .Cells(i, 4) & calcWeek
 conECD = arrHolder(i, 5) & arrHolder(i, 3) & arrHolder(i, 4) & calcWeek
 ' It looks like you use this block a few times with different variables. Consider extracting to a function
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocity.Cells(velocityRow, 12)
 End If
 'If .Cells(i, 13) <> "" Then
 ' If tempLookup <> 0 Then
 ' .Cells(i, 14).Value = Int(.Cells(i, 13) / tempLookup)
 ' End If
 'End If
 If arrHolder(i, 13) <> vbNullString Then
 If tempLookup <> 0 Then
 arrHolder(i, 14) = Int(arrHolder(i, 13) / tempLookup)
 End If
 End If
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocity.Cells(velocityRow, 13)
 End If
 'If .Cells(i, 14) > tempLookup Then
 ' If .Cells(i, 14) <> "" Then
 ' .Cells(i, 15).Value = tempLookup
 ' End If
 'Else
 ' .Cells(i, 15).Value = .Cells(i, 14).Value
 'End If
 If arrHolder(i, 14) > tempLookup Then
 If arrHolder(i, 14) <> vbNullString Then
 arrHolder(i, 15) = tempLookup
 End If
 Else
 arrHolder(i, 15) = arrHolder(i, 14)
 End If
 'If .Cells(i, 14) = "" Then
 ' If .Cells(i, 11) = "" Then
 ' .Cells(i, 26) = ""
 ' Else
 ' .Cells(i, 26).Value = Round(.Cells(i, 14).Value * .Cells(i, 11).Value, 0)
 ' End If
 'End If
 If arrHolder(i, 14) = vbNullString Then
 If arrHolder(i, 11) = vbNullString Then
 arrHolder(i, 26) = vbNullString
 Else
 arrHolder(i, 26) = Round(arrHolder(i, 14) * arrHolder(i, 11), 0)
 End If
 End If
 'tempLookup = Application.Index(indexQuantity, Application.Match((.Cells(i, 21).Value & "LIBERTY") _
 ' , matchQuantity, False))
 tempLookup = Application.Index(indexQuantity, Application.Match((arHolder(i, 21) & "LIBERTY") _
 , matchQuantity, False))
 '.Cells(i, 24).Value = tempLookup
 arrHolder(i, 24) = tempLookup
 ' I havent used application SumIf on an array before, so I instead edited this so it should use the correct index value.
 ' This will likely not work as I want it to, so it may just need to go into a separate loop or something.
 ' .Cells(i, 18).Value = .Cells(i, 24) - Application.SumIf(.Range(.Cells(1, 21), .Cells(i, 21)), _
 ' .Cells(i, 21).Value, .Range(.Cells(1, 26), .Cells(i, 26)))
 arrHolder(i, 18) = .Cells(i + 1, 24) - Application.SumIf(.Range(.Cells(1, 21), .Cells(i + 1, 21)), _
 .Cells(i + 1, 21).Value, .Range(.Cells(1, 26), .Cells(i + 1, 26)))
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 13)
 End If
 'If .Cells(i, 26) > tempLookup Then
 ' .Cells(i, 28).Value = tempLookup
 'Else
 ' .Cells(i, 28).Value = .Cells(i, 26).Value
 'End If
 If arrHolder(i, 26) > tempLookup Then
 arrHolder(i, 28) = tempLookup
 Else
 arrHolder(i, 28) = arrHolder(i, 26)
 End If
 'If .Cells(i, 18).Value < 0 Then
 ' .Cells(i, 29).Value = "C"
 ' .Cells(i, 27).Value = ""
 'Else
 ' .Cells(i, 27) = .Cells(i, 28)
 'End If
 If arrHolder(i, 18) < 0 Then
 arrHolder(i, 29) = "C"
 arrHolder(i, 27) = vbNullString
 Else
 arrHolder(i, 27) = arrHolder(i, 28)
 End If
 '.Cells(i, 31).Value = Application.SumIf(.Range(.Cells(2, 1), .Cells(lrMain, 1)), _
 ' .Cells(i, 1).Value, .Range(.Cells(2, 27), .Cells(lrMain, 27)))
 ' Another SumIf. Same as before, we will have to figure this out separately.
 arrHolder(i, 31) = Application.SumIf(.Range(.Cells(2, 1), .Cells(lrMain, 1)), _
 .Cells(i + 1, 1).Value, .Range(.Cells(2, 27), .Cells(lrMain, 27)))
 'If .Cells(i, 5) = "" Then
 ' .Cells(i, 35) = ""
 'Else
 ' .Cells(i, 35).Value = Application.Index(indexVelocity1, _
 ' Application.Match(.Cells(i, 5), matchVelocity1, False))
 'End If
 ' Thinking about it now, I am not sure about Application Index/Match on an array either.
 If arrHolder(i, 5) = vbNullString Then
 arrHolder(i, 35) = vbNullString
 Else
 arrHolder(i, 35) = Application.Index(indexVelocity1, _
 Application.Match(arrHolder(i, 5), matchVelocity1, False))
 End If
 'If .Cells(i, 6).Value = 0 Then
 ' .Cells(i, 44).Value = 0
 'Else
 ' .Cells(i, 44).Value = Round(((((.Cells(i, 6).Value / .Cells(i, 11).Value) _
 ' / .Cells(i, 10).Value) - .Cells(i, 8).Value) / .Cells(i, 35).Value), 0.1)
 'End If
 If arrHolder(i, 6) = 0 Then
 arrHolder(i, 44) = 0
 Else
 arrHolder(i, 44) = Round(((((arrHolder(i, 6) / arrHolder(i, 11)) _
 / arrHolder(i, 10)) - arrHolder(i, 8)) / arrHolder(i, 35)), 0.1)
 End If
 'If .Cells(i, 6).Value = 0 Then
 ' .Cells(i, 34).Value = 0
 ' .Cells(i, 33) = 0
 'Else
 ' .Cells(i, 34).Value = Round(((((.Cells(i, 6) / .Cells(i, 11)) / _
 ' .Cells(i, 10)) - .Cells(i, 8)) / .Cells(i, 35)) * .Cells(i, 11), 0.1)
 ' If .Cells(i, 34) > 0 Then
 ' .Cells(i, 33) = .Cells(i, 34)
 ' Else
 ' .Cells(i, 33) = 0
 ' End If
 'End If
 If arrHolder(i, 6) = 0 Then
 arrHolder(i, 34) = 0
 arrHolder(i, 33) = 0
 Else
 arrHolder(i, 34) = Round(((((arrHolder(i, 6) / arrHolder(i, 11)) / _
 arrHolder(i, 10)) - arrHolder(i, 8)) / arrHolder(i, 35)) * arrHolder(i, 11), 0.1)
 If arrHolder(i, 34) > 0 Then
 arrHolder(i, 33) = arrHolder(i, 34)
 Else
 arrHolder(i, 33) = 0
 End If
 End If
 '.Cells(i, 37) = 1 + calcWeek
 arrHolder(i, 37) = 1 + calcWeek
 '.Cells(i, 38) = .Cells(i, 5) & .Cells(i, 37)
 arrHolder(i, 38) = arrHolder(i, 5) & arrHolder(i, 37)
 '.Cells(i, 39).Value = Application.Index(indexVelocity2, _
 ' Application.Match(.Cells(i, 38), matchVelocity2, False))
 arrHolder(i, 39) = Application.Index(indexVelocity2, _
 Application.Match(arrHolder(i, 38), matchVelocity2, False))
 '.Cells(i, 40) = Round(((((.Cells(i, 6) / .Cells(i, 11)) * .Cells(i, 39)) _
 ' - .Cells(i, 6)) - (.Cells(i, 8) - .Cells(i, 6))) / .Cells(i, 35), 0.1)
 arrHolder(i, 40) = Round(((((arrHolder(i, 6) / arrHolder(i, 11)) * arrHolder(i, 39)) _
 - arrHolder(i, 6)) - (arrHolder(i, 8) - arrHolder(i, 6))) / arrHolder(i, 35), 0.1)
 'If .Cells(i, 40) < 0 Then
 ' .Cells(i, 41) = 0
 'Else
 ' .Cells(i, 41) = .Cells(i, 40)
 'End If
 If arrHolder(i, 40) < 0 Then
 arrHolder(i, 41) = 0
 Else
 arrHolder(i, 41) = arrHolder(i, 40)
 End If
 '.Cells(i, 42) = .Cells(i, 41) - .Cells(i, 33)
 arrHolder(i, 42) = arrHolder(i, 41) - arrHolder(i, 33)
 'If .Cells(i, 11) < .Cells(1, 44) Then
 ' .Cells(i, 45) = 0
 ' .Cells(i, 32) = .Cells(i, 45)
 'Else
 ' .Cells(i, 32) = Application.Max(.Cells(i, 33), .Cells(i, 41))
 ' If .Cells(i, 44) < 0 Then
 ' .Cells(i, 45) = ""
 ' Else
 ' .Cells(i, 45) = .Cells(i, 44)
 ' End If
 'End If
 ' Not 100% sure if applicaiton.max will work here.
 If arrHolder(i, 11) < arrHolder(1, 44) Then
 arrHolder(i, 45) = 0
 arrHolder(i, 32) = arrHolder(i, 45)
 Else
 arrHolder(i, 32) = Application.Max(arrHolder(i, 33), arrHolder(i, 41))
 If arrHolder(i, 44) < 0 Then
 arrHolder(i, 45) = vbNullString
 Else
 arrHolder(i, 45) = arrHolder(i, 44)
 End If
 End If
 'If .Cells(i, 31) < ShipMin Then
 ' .Cells(i, 47) = 0
 'Else
 ' .Cells(i, 47) = .Cells(i, 27)
 'End If
 If arrHolder(i, 31) < ShipMin Then
 arrHolder(i, 47) = 0
 Else
 arrHolder(i, 47) = arrHolder(i, 27)
 End If
 '.Cells(i, 46) = .Cells(i, 1) & .Cells(i, 22) & .Cells(i, 47)
 arrHolder(i, 46) = arrHolder(i, 1) & arrHolder(i, 22) & arrHolder(i, 47)
 End With
 If (i Mod 100) = 0 Then
 Debug.Print "Got to row "; i; " in "; Timer - MainTimer; " seconds."
 End If
Next i
wsMain.Range(wsMain.Cells(2, 1), wsMain.Cells(lrMain, 47).Value = arrHolder
Erase arrHolder
End Sub

• Emily Alden: On the SumIf lines why did you use I+1 instead of I. I've followed everything up until then.
• Brandon Barney: Because your data starts at row 2, but the array is likely going to load in as a 1 base array (meaning it's first row is 1). So 'i' will be '1', but your cell actually needs '2' thus I use a calculation to add an offset of '1' to 'i'. ideally, I would actually calculate the difference between a cell starting point and the LBound of the array, but I dont think I have ever had an issue with assuming the LBound was 1 when assigning a range to an array directly. Also, the offset is only when referencing cells and not arrays. You dont need to offset from array values.
• Emily Alden: That makes sense. Thank you so much for catching that offset!
• Brandon Barney: No problem at all :). Its part of using arrays. You have to be mindful of the index position you are using.

Answer 2

Clearly non-working code, to be used as a guide.

Basically when working with arrays, you copy the data from your Worksheet.Range to a memory-based array in your VBA. Make all changes and calculations to the data within that memory array. Then transfer the finished array data back to the worksheet.

Here is a VERY quick and VERY dirty conversion of your main loop to use an array. Obviously, I can't test the code against any data. The important parts of the array are at the top:

Dim lastRow As Long
Dim lastCol As Long
lastRow = 500000 'make this a calculation
lastCol = 15 'make this a calculation or fixed
'--- capture the data to a memory array
Dim mainData As Variant
Dim mainDataArea As Range
Set mainDataArea = wsMain.Range("A1").Resize(lastRow, lastCol)
mainData = mainDataArea

(You know better how to determine the lastRow and lastCol)

Then after you run your loop, you put it back:

'--- copy the finished array back to the worksheet
mainDataArea = mainData

I did a quick global search and replace to at least get a start on your main loop for you to check out as a guide for what kinds of things you'd have to change.

Const FIRSTNAME = 1 'column constants will make it far easier to debug
Const LASTNAME = 2
Const ADDRESS = 3
Const CITY = 4
Const STATE = 21
' . . .
Dim lastRow As Long
Dim lastCol As Long
lastRow = 500000 'make this a calculation
lastCol = 15 'make this a calculation or fixed
'--- capture the data to a memory array
Dim mainData As Variant
Dim mainDataArea As Range
Set mainDataArea = wsMain.Range("A1").Resize(lastRow, lastCol)
mainData = mainDataArea
For i = 2 To lrMain
 Dim conUD As String 'con=concatenate
 conUD = mainData(i, 21) & mainData(i, 4) & calcWeek
 '---should be mainData(i, STATE) & mainData(i, CITY) & calcWeek
 mainData(i, 21) = mainData(i, 5) & mainData(i, 3)
 If mainData(i, 8) <> 0 Then
 mainData(i, 9) = mainData(i, 6) / mainData(i, 8)
 End If
 Dim velocityRow As Long
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocitymainData(velocityRow, 11)
 End If
 mainData(i, 10) = tempLookup
 tempLookup = wsVelocitymainData(velocityRow, 14)
 mainData(i, 11) = tempLookup
 If mainData(i, 9) > mainData(i, 11) Then
 mainData(i, 12) = Round((mainData(i, 6) / mainData(i, 11)) / mainData(i, 10), 0.1)
 End If
 If mainData(i, 6) > 0 Then
 If mainData(i, 12) <> "" Then
 mainData(i, 13) = mainData(i, 12) - mainData(i, 8)
 End If
 End If
 Dim conECD As String
 conECD = mainData(i, 5) & mainData(i, 3) & mainData(i, 4) & calcWeek
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocitymainData(velocityRow, 12)
 End If
 If mainData(i, 13) <> "" Then
 If tempLookup <> 0 Then
 mainData(i, 14) = Int(mainData(i, 13) / tempLookup)
 End If
 End If
 If velocityLookup.Exists(conECD) Then
 velocityRow = velocityLookup.Item(conECD)
 tempLookup = wsVelocitymainData(velocityRow, 13)
 End If
 If mainData(i, 14) > tempLookup Then
 If mainData(i, 14) <> "" Then
 mainData(i, 15) = tempLookup
 End If
 Else
 mainData(i, 15) = mainData(i, 14)
 End If
 If mainData(i, 14) = "" Then
 If mainData(i, 11) = "" Then
 mainData(i, 26) = ""
 Else
 mainData(i, 26) = Round(mainData(i, 14) * mainData(i, 11), 0)
 End If
 End If
 tempLookup = Application.Index(indexQuantity, Application.Match((mainData(i, 21) & "LIBERTY") _
 , matchQuantity, False))
 mainData(i, 24) = tempLookup
 mainData(i, 18) = mainData(i, 24) - Application.SumIf(.Range(mainData(1, 21), mainData(i, 21)), _
 mainData(i, 21), .Range(mainData(1, 26), mainData(i, 26)))
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocitymainData(velocityRow, 13)
 End If
 If mainData(i, 26) > tempLookup Then
 mainData(i, 28) = tempLookup
 Else
 mainData(i, 28) = mainData(i, 26)
 End If
 If mainData(i, 18) < 0 Then
 mainData(i, 29) = "C"
 mainData(i, 27) = ""
 Else
 mainData(i, 27) = mainData(i, 28)
 End If
 mainData(i, 31) = Application.SumIf(.Range(mainData(2, 1), mainData(lrMain, 1)), _
 mainData(i, 1), .Range(mainData(2, 27), mainData(lrMain, 27)))
 If mainData(i, 5) = "" Then
 mainData(i, 35) = ""
 Else
 mainData(i, 35) = Application.Index(indexVelocity1, _
 Application.Match(mainData(i, 5), matchVelocity1, False))
 End If
 If mainData(i, 6) = 0 Then
 mainData(i, 44) = 0
 Else
 mainData(i, 44) = Round(((((mainData(i, 6) / mainData(i, 11)) _
 / mainData(i, 10)) - mainData(i, 8)) / mainData(i, 35)), 0.1)
 End If
 If mainData(i, 6) = 0 Then
 mainData(i, 34) = 0
 mainData(i, 33) = 0
 Else
 mainData(i, 34) = Round(((((mainData(i, 6) / mainData(i, 11)) / _
 mainData(i, 10)) - mainData(i, 8)) / mainData(i, 35)) * mainData(i, 11), 0.1)
 If mainData(i, 34) > 0 Then
 mainData(i, 33) = mainData(i, 34)
 Else
 mainData(i, 33) = 0
 End If
 End If
 mainData(i, 37) = 1 + calcWeek
 mainData(i, 38) = mainData(i, 5) & mainData(i, 37)
 mainData(i, 39) = Application.Index(indexVelocity2, _
 Application.Match(mainData(i, 38), matchVelocity2, False))
 mainData(i, 40) = Round(((((mainData(i, 6) / mainData(i, 11)) * mainData(i, 39)) _
 - mainData(i, 6)) - (mainData(i, 8) - mainData(i, 6))) / mainData(i, 35), 0.1)
 If mainData(i, 40) < 0 Then
 mainData(i, 41) = 0
 Else
 mainData(i, 41) = mainData(i, 40)
 End If
 mainData(i, 42) = mainData(i, 41) - mainData(i, 33)
 If mainData(i, 11) < mainData(1, 44) Then
 mainData(i, 45) = 0
 mainData(i, 32) = mainData(i, 45)
 Else
 mainData(i, 32) = Application.Max(mainData(i, 33), mainData(i, 41))
 If mainData(i, 44) < 0 Then
 mainData(i, 45) = ""
 Else
 mainData(i, 45) = mainData(i, 44)
 End If
 End If
 If mainData(i, 31) < ShipMin Then
 mainData(i, 47) = 0
 Else
 mainData(i, 47) = mainData(i, 27)
 End If
 mainData(i, 46) = mainData(i, 1) & mainData(i, 22) & mainData(i, 47)
 If (i Mod 100) = 0 Then
 Debug.Print "Got to row "; i; " in "; Timer - MainTimer; " seconds."
 End If
Next i
'--- copy the finished array back to the worksheet
mainDataArea = mainData

• Emily Alden: This make sense overall. A couple of quick questions: Will the "Application.SumIf" work on an array? Also Index/Match and Max? If not is there a good workaround for these?
• PeterT: The SUMIF, INDEX, and MATCH don't work on memory arrays. But you can either re-write your code to not use them, or substitute your own function to replace them. An example of an array-based SUMIF is here.

Answer 3

The slowest parts are usually the multiple calls between VBA and Excel. The main approach to that is to get all contiguous data at once into array, and put it back all at once when done. But! Excel calculations can be done in parallel on multiple threads, and VBA is limited to one thread. Meaning that for a big range, using Excel formulas can be faster than VBA loops over arrays.

For example:

For i = 2 To 5 'lrQuantity
 With wsQuantity
 .Cells(i, 5) = .Cells(i, 1) & .Cells(i, 2)
 .Cells(i, 6) = .Cells(i, 1) & UCase(.Cells(i, 2).Value) & .Cells(i, 3)
 End With
Next i

can be shortened to:

wsQuantity.Range("E2:E5") = wsQuantity.Evaluate("index(A2:A5 & B2:B5,)")
wsQuantity.Range("F2:F5") = wsQuantity.[index(A2:A5 & Upper(B2:B5) & C2:C5,)] ' [] is short for Evaluate("")

or:

With wsQuantity.Range("E2:F5")
 .Formula = Array("= A2 & B2", "= A2 & Upper(B2) & C2") ' relative references (no $) are auto adjusted
 .Value2 = .Value2 ' optional to convert the formulas to values
End With

---

As a side note, I couldn't comprehend more than a page of what the code is doing, but in most cases VBA is not the best approach for aggregating data. There are other alternatives in Excel that are a bit easier than SQL queries like Power Query, Microsoft Query, and in some cases even PivotTable that can get the process down to minutes. I would highly recommend looking into Power Query if your Excel version supports it, as you can use most of it even after moving the process to a database system.