Excel 'big' data processing with vlookups

Question

I was given code a while back that was a mess, and have completely rewritten it. However now the code takes .2 seconds per line which for a 500,000 line document is much too long.

Purpose of the Code: This code takes the new information that has been provided by a cleaned data dump and recalculates all columns based on the new information. A large number of VLookups are employed to cross reference the data between the sheets.

Notes:

• We are investing in either a new program or frame for this data (possibly R), but it needs to be functional in two months and the individuals who are experts in R are tied up in other high priority projects for the next 5 months and IT estimates 7 months before they could put something together. Therefore I was tasked with getting this version to run.
• The report has to be finished each morning before 10:00am so there is a strong preference to get it under 3 hours of total processing time. Currently it would take approximately 28 hours to run.
• I have never done optimisation before, I have not used data tables, I do not know python or SQL. I am willing to learn any/all of these things if you are willing to point me in the direction of what aspects I should focus on learning. I am also self taught in VBA and am constantly learning new ways to improve my code and formatting.
• Everything before it starts looping through "For RC =2 To lrMain" takes about a three minutes total to run all lines. I am not as concerned about it.
• There are no in cell computations happening anywhere on this workbook.
• Unless it is absolutely necessary restructuring the data and sheets is not an option, however creating additional sheets or files to hold data is not an issue.
• I appreciate any and all help on this. I am in way over my head.

Sub Calculate_Click()
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 conUD As String 'con=concatenate'
Dim conECD As String
Dim calcWeek As Long
Dim RC As Long 'Row Counter'
Dim vl As Variant 'Vlookup, Variant to allow for errors without breaking the code'
'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
calcWeek = wsParameters.Range("B3").Value
'******************* Insert a line to freeze screen here.'
For RC = 2 To lrQuantity
 With wsQuantity
 .Cells(RC, 5) = .Cells(RC, 1) & .Cells(RC, 2)
 .Cells(RC, 6) = .Cells(RC, 1) & UCase(.Cells(RC, 2).Value) & .Cells(RC, 3)
 End With
Next RC
wsData.Range(wsData.Cells(2, 1), wsData.Cells(lrData, 4)).Sort _
 key1:=wsData.Range("A2"), order1:=xlAscending, Header:=xlNo
For RC = 2 To lrData
 vl = Application.VLookup(wsData.Cells(RC, 2), wsParameters.Range("Table5"), 2, False)
 If IsError(vl) Then
 wsData.Cells(RC, 3).Value = "Missing"
 Else
 wsData.Cells(RC, 3).Value = vl
 End If
Next RC
For RC = 2 To lrVelocity
 With wsVelocity
 .Cells(RC, 10) = .Cells(RC, 1) & .Cells(RC, 4) & .Cells(RC, 5) & .Cells(RC, 9)
 .Cells(RC, 10).Value = CStr(Trim(.Cells(RC, 10).Value))
 .Cells(RC, 11) = .Cells(RC, 6)
 .Cells(RC, 12) = .Cells(RC, 7)
 .Cells(RC, 13) = .Cells(RC, 8)
 .Cells(RC, 14) = .Cells(RC, 3)
 .Cells(RC, 22) = .Cells(RC, 1) & .Cells(RC, 9)
 End With
Next RC
wsVelocity.Range(wsVelocity.Cells(2, 1), wsVelocity.Cells(lrVelocity, 10)).Sort _
 key1:=wsVelocity.Range("J2"), order1:=xlAscending, Header:=xlNo
For RC = 2 To lrMain
 wsMain.Cells(RC, 21) = wsMain.Cells(RC, 5) & wsMain.Cells(RC, 3)
 If wsMain.Cells(RC, 8) <> 0 Then
 wsMain.Cells(RC, 9) = wsMain.Cells(RC, 6) / wsMain.Cells(RC, 8)
 End If
 conUD = wsMain.Cells(RC, 21) & wsMain.Cells(RC, 4) & calcWeek
 conUD = CStr(Trim(conUD))
 vl = Application.VLookup(conUD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 11)), 2, False)
 If IsError(vl) Then
 wsMain.Cells(RC, 10).Value = "Missing"
 Else
 wsMain.Cells(RC, 10).Value = vl
 End If
 vl = Application.VLookup(conUD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14)), 5, False)
 If IsError(vl) Then
 wsMain.Cells(RC, 11).Value = "Missing"
 Else
 wsMain.Cells(RC, 11).Value = vl
 End If
 If wsMain.Cells(RC, 11) <> 0 And wsMain.Cells(RC, 9) > wsMain.Cells(RC, 11) Then
 wsMain.Cells(RC, 12).Value = Round((wsMain.Cells(RC, 6) / wsMain.Cells(RC, 11)) / wsMain.Cells(RC, 10), 0.1)
 Else
 wsMain.Cells(RC, 12).Value = ""
 End If
 If wsMain.Cells(RC, 6) > 0 And wsMain.Cells(RC, 12) <> "" Then
 wsMain.Cells(RC, 13).Value = wsMain.Cells(RC, 12) - wsMain.Cells(RC, 8)
 Else
 wsMain.Cells(RC, 13).Value = ""
 End If
 conECD = wsMain.Cells(RC, 5) & wsMain.Cells(RC, 3) & wsMain.Cells(RC, 4) & calcWeek
 vl = Application.VLookup(conECD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14)), 3, False)
 If wsMain.Cells(RC, 12) > 0 And wsMain.Cells(RC, 12) <> "" And wsMain.Cells(RC, 13) <> "" Then
 If IsError(vl) Then
 wsMain.Cells(RC, 14).Value = "Missing"
 Else
 wsMain.Cells(RC, 14).Value = Int(wsMain.Cells(RC, 13) / vl)
 End If
 End If
 vl = Application.VLookup(conECD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14)), 4, False)
 If IsError(vl) Then
 wsMain.Cells(RC, 15) = "Missing"
 Else
 If wsMain.Cells(RC, 14) > vl And wsMain.Cells(RC, 14) <> "" Then
 wsMain.Cells(RC, 15).Value = vl
 Else
 wsMain.Cells(RC, 15).Value = wsMain.Cells(RC, 14).Value
 End If
 End If
 If wsMain.Cells(RC, 14) = "Missing" Or wsMain.Cells(RC, 14) = "" Or wsMain.Cells(RC, 11) = "Missing" Or wsMain.Cells(RC, 11) = "" Then
 wsMain.Cells(RC, 26).Value = ""
 Else
 wsMain.Cells(RC, 26).Value = Round(wsMain.Cells(RC, 14).Value * wsMain.Cells(RC, 11).Value, 0)
 End If
 vl = Application.Index(wsQuantity.Range(wsQuantity.Cells(2, 4), wsQuantity.Cells(lrQuantity, 4)), _
 Application.Match((wsMain.Cells(RC, 21).Value & "LIBERTY"), wsQuantity.Range(wsQuantity.Cells(2, 6), wsQuantity.Cells(lrQuantity, 6)), False))
 If IsError(vl) Then
 wsMain.Cells(RC, 24).Value = ""
 Else
 wsMain.Cells(RC, 24).Value = vl
 End If
 wsMain.Cells(RC, 18).Value = wsMain.Cells(RC, 24) - Application.SumIf(wsMain.Range(wsMain.Cells(1, 21), wsMain.Cells(RC, 21)), wsMain.Cells(RC, 21).Value, wsMain.Range(wsMain.Cells(1, 26), wsMain.Cells(RC, 26)))
 If wsMain.Cells(RC, 18).Value < 0 Then
 wsMain.Cells(RC, 29).Value = "C"
 Else
 wsMain.Cells(RC, 29).Value = ""
 End If
 vl = Application.VLookup(conECD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(RC, 14)), 4)
 If IsError(vl) Then
 wsMain.Cells(RC, 28) = "Missing"
 Else
 If wsMain.Cells(RC, 26) > vl And wsMain.Cells(RC, 26) <> "" Then
 wsMain.Cells(RC, 28).Value = vl
 Else
 wsMain.Cells(RC, 28).Value = wsMain.Cells(RC, 26).Value
 End If
 End If
 If wsMain.Cells(RC, 29).Value = "C" Then
 wsMain.Cells(RC, 27).Value = 0
 Else
 wsMain.Cells(RC, 27).Value = wsMain.Cells(RC, 28)
 End If
 wsMain.Cells(RC, 31).Value = Application.SumIf(wsMain.Range(wsMain.Cells(2, 1), wsMain.Cells(lrMain, 1)), wsMain.Cells(RC, 1).Value, wsMain.Range(wsMain.Cells(2, 27), wsMain.Cells(lrMain, 27)))
 If wsMain.Cells(RC, 5) = "" Then
 wsMain.Cells(RC, 35) = ""
 Else
 wsMain.Cells(RC, 35).Value = Application.Index(wsVelocity.Range(wsVelocity.Cells(2, 7), wsVelocity.Cells(lrVelocity, 7)), _
 Application.Match(wsMain.Cells(RC, 5), wsVelocity.Range(wsVelocity.Cells(2, 1), wsVelocity.Cells(lrVelocity, 1)), False))
 End If
 If wsMain.Cells(RC, 6).Value = 0 Or wsMain.Cells(RC, 6).Value = "Missing" Or wsMain.Cells(RC, 10).Value = "Missing" Then
 wsMain.Cells(RC, 44).Value = 0
 Else
 wsMain.Cells(RC, 44).Value = Round(((((wsMain.Cells(RC, 6).Value / wsMain.Cells(RC, 11).Value) _
 / wsMain.Cells(RC, 10).Value) - wsMain.Cells(RC, 8).Value) / wsMain.Cells(RC, 35).Value), 0.1)
 End If
 If wsMain.Cells(RC, 11).Value = 0 Or wsMain.Cells(RC, 10).Value = "Missing" Then
 wsMain.Cells(RC, 34).Value = 0
 Else
 If wsMain.Cells(RC, 6).Value = 0 Then
 wsMain.Cells(RC, 34).Value = 0
 Else
 wsMain.Cells(RC, 34).Value = Round(((((wsMain.Cells(RC, 6) / wsMain.Cells(RC, 11)) _
 / wsMain.Cells(RC, 10)) - wsMain.Cells(RC, 8)) / wsMain.Cells(RC, 35)) * wsMain.Cells(RC, 11), 0.1)
 End If
 End If
 If wsMain.Cells(RC, 34) < 0 Then
 wsMain.Cells(RC, 33) = 0
 Else
 wsMain.Cells(RC, 33) = wsMain.Cells(RC, 34)
 End If
 If wsMain.Cells(RC, 1) = "" Then
 wsMain.Cells(RC, 37).Value = ""
 Else
 wsMain.Cells(RC, 37) = 1 + calcWeek
 End If
 If wsMain.Cells(RC, 37) = "" Then
 wsMain.Cells(RC, 38).Value = ""
 Else
 wsMain.Cells(RC, 38) = wsMain.Cells(RC, 5) & wsMain.Cells(RC, 37)
 End If
 wsMain.Cells(RC, 39).Value = Application.Index(wsVelocity.Range(wsVelocity.Cells(2, 3), wsVelocity.Cells(lrVelocity, 3)), _
 Application.Match(wsMain.Cells(RC, 38), wsVelocity.Range(wsVelocity.Cells(2, 22), wsVelocity.Cells(lrVelocity, 22)), False))
 If wsMain.Cells(RC, 11) = 0 Or wsMain.Cells(RC, 10) = "Missing" Then
 wsMain.Cells(RC, 40) = 0
 Else
 wsMain.Cells(RC, 40) = Round(((((wsMain.Cells(RC, 6) / wsMain.Cells(RC, 11)) * wsMain.Cells(RC, 39)) _
 - wsMain.Cells(RC, 6)) - (wsMain.Cells(RC, 8) - wsMain.Cells(RC, 6))) / wsMain.Cells(RC, 35), 0.1)
 End If
 If wsMain.Cells(RC, 40) = "" Then
 wsMain.Cells(RC, 41) = ""
 Else
 If wsMain.Cells(RC, 40) < 0 Then
 wsMain.Cells(RC, 41) = 0
 Else
 wsMain.Cells(RC, 41) = wsMain.Cells(RC, 40)
 End If
 End If
 If wsMain.Cells(RC, 41) = "" Then
 wsMain.Cells(RC, 42) = ""
 Else
 wsMain.Cells(RC, 42) = wsMain.Cells(RC, 41) - wsMain.Cells(RC, 33)
 End If
 If wsMain.Cells(RC, 11) < wsMain.Cells(1, 44) Then
 wsMain.Cells(RC, 45) = 0
 Else
 If wsMain.Cells(RC, 44) < 0 Then
 wsMain.Cells(RC, 45) = ""
 Else
 wsMain.Cells(RC, 45) = wsMain.Cells(RC, 44)
 End If
 End If
 If wsMain.Cells(RC, 11) < wsMain.Cells(1, 44) Then
 wsMain.Cells(RC, 32) = wsMain.Cells(RC, 45)
 Else
 wsMain.Cells(RC, 32) = Application.Max(wsMain.Cells(RC, 33), wsMain.Cells(RC, 41))
 End If
 If wsMain.Cells(RC, 31) < wsParameters.Cells(7, 2) Then
 wsMain.Cells(RC, 47) = 0
 Else
 wsMain.Cells(RC, 47) = wsMain.Cells(RC, 27)
 End If
 wsMain.Cells(RC, 46) = wsMain.Cells(RC, 1) & wsMain.Cells(RC, 22) & wsMain.Cells(RC, 47)
If (RC Mod 100) = 0 Then
Debug.Print "Got to row "; RC; " in "; Timer - MainTimer; " seconds."
End If
Next RC
End Sub

Troubleshooting the answer code: For some reason the "BuildVelocityLookup" is only looping through twice instead of once for each row.

'At the very top of the module, before "Option Explicit"
Dim velocityLookup As Scripting.Dictionary
Const Velocity_Key_Col As Long = 10
Sub BuildVelocityLookup(target As Worksheet, keyCol As Long, lookup As Scripting.Dictionary)
 Set lookup = New Scripting.Dictionary
 With target
 Dim lastRow As Long
 lastRow = .Range(.Cells(2, keyCol), .Cells(.Rows.Count, keyCol)).End(xlUp).Row
 Dim keys As Variant
 keys = .Range(.Cells(2, keyCol), .Cells(lastRow, keyCol)).Value
 Dim i As Long
 For i = LBound(keys) To UBound(keys)
 'Note that the row is offset from the array.
 lookup.Add keys(i, 1), i + 1
 Next
 End With
End Sub
' ******** This Sub is written by Emily Alden. Please reach out to her before editing.
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, 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
 Dim velocityRow As Long
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 1)
 End If
 .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
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 12)
 End If
 .Cells(i, 10).Value = tempLookup
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 15)
 End If
 .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(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 3)
 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(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 tempLookup = wsVelocity.Cells(velocityRow, 14)
 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, 14)
 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

• R3uK: 28 hours Ouch! At first, glance, there is far too much testing on the sheets, you should load the sheets in arrays and work as much as possible with the arrays, you'll gain a LOT of time just with that. Furthermore, you don't seem to have any kind of perf improvements tuning of the application. I was about to post one of my wrappers to get some opinions on it, I'll come back in a bit to give the link so that you can see what I mean! ;) Try to rewrite this with arrays meanwhile, I can promise you it'll be worth it! ;)
• Comintern: Unless you're doing some really extensive processing, something like this should really only be running on the order of minutes (if not seconds).
• Comintern: That just means there's going to be a lot of review material. ;-)
• R3uK: @EmilyAlden : Yup, it stands for performances : See codereview.stackexchange.com/questions/158048/…
• Comintern: When you say "recalculates all columns based on the new information", are you referring to only the cell writes that you're performing in the code, or are there formulas on the worksheets that would effect the results of your lookups?

Answer 1

Housekeeping Type Things

---

Just a couple of housekeeping type things first. I'd indent everything between Sub Calculate_Click() and End Sub one more level, and indent the timing code at the bottom to the correct level. It might seem like a small thing, but it really improves the readability of the procedure.

---

The identifier RC is a bit confusing at first glance, as is vl. I realize that they're just loop counters\temp value holders, but the comments that explain that are a long trip with the mouse wheel up to the top of the procedure. If you want to use a short throw-away loop counter, I'd suggest using i instead - it's pretty generally recognized as shorthand for "index". There's also nothing wrong with something explicit as to what it is like rowCounter or currentRow.

---

That leads to another readability issue. In a procedure this long, declaring everything in a Dim block at the top of the procedure makes it more difficult to keep track of what everything is, especially when you're using identifiers like conUD. It's usually more readable to declare a variable immediately before you use it the first time.

---

There are magic numbers everywhere. This makes it both confusing and non-obvious what cell and range indexes are referring to. I'd replace them with descriptive constants that make it obvious what is happening - this also makes your code much easier to maintain if the layout changes:

'Module level declarations
Const FOO_COLUMN As Long = 7
'etc...

Then your code looks more like this:

wsMain.Cells(i, FOO_COLUMN) = wsMain.Cells(i, BAR_COLUMN) & wsMain.Cells(i, BAZ_COLUMN)

---

I'd get into the habit of using the built in vbNullString constant. It's easier to read at a glance and doesn't require a memory allocation for an empty string.

---

Performance Type Things

---

Cache objects and values that you repeatedly use - Consider this code:

vl = Application.VLookup(conECD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14)), 3, False)
If wsMain.Cells(RC, 12) > 0 And wsMain.Cells(RC, 12) <> "" And wsMain.Cells(RC, 13) <> "" Then
 If IsError(vl) Then
 wsMain.Cells(RC, 14).Value = "Missing"
 Else
 wsMain.Cells(RC, 14).Value = Int(wsMain.Cells(RC, 13) / vl)
 End If
End If
vl = Application.VLookup(conECD, wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14)), 4, False)

You're resolving this Range twice:

wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14))

Both calls are going to return the exact same result, and they involve 3 function calls on wsVelocity sheet. In general, you should be looking for function calls that are always the same and pull them into a local reference - same thing with calculations that you know will always have the same result. For example:

Dim lookupRange As Range
Set lookupRange = wsVelocity.Range(wsVelocity.Cells(2, 10), wsVelocity.Cells(lrVelocity, 14))
vl = Application.VLookup(conECD, lookupRange, 3, False)
'...
vl = Application.VLookup(conECD, lookupRange, 4, False)

---

With Blocks - Use them. They aren't just a convenient way to avoid typing the variable name repeatedly - they hold a reference. This means that the VBA runtime doesn't have to resolve them repeatedly. That makes a big difference. Wrap the largest section that you can (I'd probably do the whole loop) and wrap it with the object you use the most:

With wsMain
 For RC = 2 To lrMain
 .Cells(RC, 21) = .Cells(RC, 5) & .Cells(RC, 3)
 If .Cells(RC, 8) <> 0 Then
 .Cells(RC, 9) = .Cells(RC, 6) / .Cells(RC, 8)
 End If
 conUD = .Cells(RC, 21) & .Cells(RC, 4) & calcWeek
 '...
 Next
End With

---

Short-circuit - VBA doesn't do this natively. When you have multiple conditions in an If statement, VBA will evaluate all of them even if the first False one makes the expression False. For example this code (line breaks for clarity)...

If wsMain.Cells(RC, 12) > 0 And _
 wsMain.Cells(RC, 12) <> "" And _
 wsMain.Cells(RC, 13) <> "" Then

...makes 3 cell reads (two are the same), but if wsMain.Cells(RC, 12) > 0 is False, it doesn't just stop there. You can either nest the statements...

Dim testValue As Variant
testValue = wsMain.Cells(RC, 12)
If testValue > 0 Then
 If testValue <> vbNullString Then
 If wsMain.Cells(RC, 13) <> vbNullString Then

...or if you have a lot of them, use a Select Case structure:

Dim testValue As Variant
testValue = wsMain.Cells(RC, 12)
Select Case False
 Case testValue <= 0
 Case testValue = vbNullString
 Case wsMain.Cells(RC, 13) = vbNullString
 Case Else
 'Your "True" case
End Select

---

VLookup - Repeated calls to VLookup are expensive, because Excel can't make the assumption that the lookup table will be the same between each call. What that means is that it can't cache anything easily. If (based on your comment) you aren't making changes to the worksheet that the lookups are being performed on or making changes that result in formulas recalculating on the lookup range, it is almost always faster to create your own lookup cache. In this case, after a cursory scan it looks like you're always using the same key column for the lookup. So... just create a set up lookup tables with Dictionary objects with the Value set to the row number (note that this assumes you have unique keys):

'Module level
Dim velocityLookup As Scripting.Dictionary
Const VELOCITY_KEY_COL As Long = 10
Private Sub BuildVelocityLookup(target As Worksheet, keyCol As Long, _
 lookup As Scripting.Dictionary)
 Set lookup = New Scripting.Dictionary
 With target
 Dim lastRow As Long
 lastRow = .Range(.Cells(2, keyCol), .Cells(.Rows.Count, keyCol)).End(xlUp).Row
 Dim keys As Variant
 keys = .Range(.Cells(2, keyCol), .Cells(lastRow, keyCol)).Value
 Dim i As Long
 For i = LBound(keys) To UBound(keys)
 'Note that the row is offset from the array.
 lookup.Add keys(i, 1), i + 1
 Next
 End With
End Sub

Call that for each of your lookups and use the Dictionary in place of the VLookup:

Sub Calculate_Click()
 BuildVelocityLookup Worksheets("Velocity"), VELOCITY_KEY_COL, velocityLookup
 '...
 Dim velocityRow As Long
 If velocityLookup.Exists(conUD) Then
 velocityRow = velocityLookup.Item(conUD)
 Dim valueYouWant As Variant
 valueYouWant = wsVelocity.Cells(velocityRow, COLUMN_YOU_NEED)
 End If

---

Use a Value array - This is probably going to be the biggest performance gain if you're able to hold the entire working Range on wsMain in memory at once. If not, you could probably "page" it by processing in chunks of 10000 rows or something like that. The implementation details are probably out of scope for my review (although another reviewer might cover it), but take a look at the BuildVelocityLookup procedure above - it pulls the column into an array and works with that. I'd probably start by tackling to lower hanging fruit above, then switch to array processing if you're still not in the performance neighbourhood you need to be in.

Good luck!

• Mathieu Guindon: Comments are not for extended discussion; this conversation has been moved to chat.