7
\$\begingroup\$

I am a self taught VBA user. I was asked to look at the code from a tool which has stopped working due to a data overflow and "fix" it. I was told the code was 'optimised' so that it took only 2 hours to run instead of four. They did this by remove loops.

I didn't have an issue with my 64-bit Excel, but another user stepped through it for me and the below lines prompted the 'out of memory' error.

Calculations are set to manual and the screen is frozen at the beginning of the code.

In my limited experience I've had faster results doing a loop and avoiding setting formulas in the document. There are around 500,000 lines of data currently.

Would I be better off changing it to a loop? Or would that add hours onto the computation time? I'm happy to post the full code if anyone wants to see it, but it is not annotated and none of the variables are defined so it is a bit of a mess. I'm cleaning it up as I decipher the code.

Sheets("Main Tab").Range("O2:O" & LastRow).Formula = "=IF(AND(N2>IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""),N2)"
Sheets("Main Tab").Range("I2:O" & LastRow).Value = Sheets("Main Tab").Range("I2:O" & LastRow).Value

Full code (Calculate_Click is what is causing the issue):

 Sub Clear_Click()
 DisableOptimize
 UnfilterAll
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 MainTabLastColum = "AU"
 Sheets("Order Upload").AutoFilterMode = False
 Sheets("Main Tab").AutoFilterMode = False
 Sheets("Microstrategy Data").AutoFilterMode = False
 Sheets("Velocity").AutoFilterMode = False
 LastRow = Sheets("Order Upload").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow > 1 Then
 Sheets("Order Upload").Range("A2:K" & LastRow).ClearContents
 End If
 LastRow = Sheets("SKU-DC Summary").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow > 1 Then
 Sheets("SKU-DC Summary").Range("A2:S" & LastRow).ClearContents
 End If
 LastRow = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow > 1 Then
 Sheets("Main Tab").Range("A2:" & MainTabLastColum & LastRow).ClearContents
 End If
 LastRow = Sheets("Microstrategy Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow > 1 Then
 Sheets("Microstrategy Data").Range("A2:H" & LastRow).ClearContents
 End If
 LastRow = Sheets("Velocity").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 If LastRow > 1 Then
 Sheets("Velocity").Range("J2:N" & LastRow).ClearContents
 Sheets("Velocity").Range("V2:V" & LastRow).ClearContents
 End If
 MainTabLastColum = Null
 QuantityLastColumn = Null
 LastRow = Null
End Sub
Sub LoadMicroData2()
 Dim StartTime As Double
 Dim SecondsElapsed As Double
 StartTime = Timer
 DisableOptimize
 LastRowMsCopyTo = Sheets("Microstrategy Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 LastRowMsCopyFrom = Sheets("Data Input Microstrategy").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Call CopyValues(Sheets("Data Input Microstrategy").Range("A7:A" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("A2:A" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("B7:B" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("B2:B" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("C7:C" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("C2:C" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("D7:D" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("E2:E" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("E7:E" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("F2:F" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("F7:F" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("G2:G" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Data Input Microstrategy").Range("G7:G" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("H2:H" & LastRowMsCopyFrom))
 LastRowMsCopyTo = Sheets("Microstrategy Data").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Microstrategy Data").Range("D2:D" & LastRowMsCopyTo).Formula = "=Index('Data Input by Account'!$D:$D,match($A2,'Data Input by Account'!$A:$A,false))"
 Worksheets("Microstrategy Data").UsedRange.Columns("D").Calculate
 Call CopyValues(Sheets("Microstrategy Data").Range("D2:D" & LastRowMsCopyFrom), Sheets("Microstrategy Data").Range("D2:D" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("A2:A" & LastRowMsCopyFrom), Sheets("Main Tab").Range("A2:A" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("B2:B" & LastRowMsCopyFrom), Sheets("Main Tab").Range("B2:B" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("C2:C" & LastRowMsCopyFrom), Sheets("Main Tab").Range("C2:C" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("D2:D" & LastRowMsCopyFrom), Sheets("Main Tab").Range("D2:D" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("E2:E" & LastRowMsCopyFrom), Sheets("Main Tab").Range("E2:E" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("F2:F" & LastRowMsCopyFrom), Sheets("Main Tab").Range("F2:F" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("G2:G" & LastRowMsCopyFrom), Sheets("Main Tab").Range("G2:G" & LastRowMsCopyFrom))
 Call CopyValues(Sheets("Microstrategy Data").Range("H2:H" & LastRowMsCopyFrom), Sheets("Main Tab").Range("H2:H" & LastRowMsCopyFrom))
 LastRow = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Application.CutCopyMode = False
 LastRowMsCopyTo = Null
 LastRowMsCopyFrom = Null
 LastRow = Null
End Sub
Sub CopyValues(rngSource As Range, rngTarget As Range)
 rngTarget.Resize(rngSource.Rows.Count, rngSource.Columns.Count).Value = rngSource.Value
End Sub
Sub Calculate_Click()
 MainTabLastColum = "AU"
 QuantityLastColumn = "O"
 Worksheets("Main Tab").Select
 DisableOptimize
 LastRowAvail = Sheets("Quantity Available").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Quantity Available").Range("E2:E" & LastRowAvail).Formula = "=CONCATENATE(A2,B2)"
 Sheets("Quantity Available").Range("F2:F" & LastRowAvail).Formula = "=CONCATENATE(A2,Upper(B2),C2)"
 Sheets("Quantity Available").Range("E2:F" & LastRowAvail).Value = Sheets("Quantity Available").Range("E2:F" & LastRowAvail).Value
 ActiveWorkbook.Worksheets("Quantity Available").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Quantity Available").Sort.SortFields.Add Key:=Range( _
 "C2:C" & LastRowAvail), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 ActiveWorkbook.Worksheets("Quantity Available").Sort.SortFields.Add Key:=Range( _
 "E2:E" & LastRowAvail), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Quantity Available").Sort
 .SetRange Range("A1:F" & LastRowAvail)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .Apply
 End With
 LastRowData = Sheets("Data Input by Account").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Data Input by Account").Range("C2:C" & LastRowData).Formula = "=VLOOKUP(B7,Table5,2,FALSE)"
 Sheets("Data Input by Account").Range("C2:C" & LastRowData).Value = Sheets("Data Input by Account").Range("C2:C" & LastRowData).Value
 ActiveWorkbook.Worksheets("Data Input by Account").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Data Input by Account").Sort.SortFields.Add Key:=Range( _
 "A2:A" & LastRowData), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Data Input by Account").Sort
 .SetRange Range("A1:D" & LastRowData)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .Apply
 End With
 VelocityLastRow = Sheets("Velocity").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Velocity").Range("J2:J" & VelocityLastRow).Formula = "=CONCATENATE(A2,D2,E2,I2)"
 Sheets("Velocity").Range("K2:K" & VelocityLastRow).Formula = "=F2"
 Sheets("Velocity").Range("L2:L" & VelocityLastRow).Formula = "=G2"
 Sheets("Velocity").Range("M2:M" & VelocityLastRow).Formula = "=H2"
 Sheets("Velocity").Range("N2:N" & VelocityLastRow).Formula = "=C2"
 Sheets("Velocity").Range("J2:N" & VelocityLastRow).Value = Sheets("Velocity").Range("J2:N" & VelocityLastRow).Value
 ActiveWorkbook.Worksheets("Velocity").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Velocity").Sort.SortFields.Add Key:=Range( _
 "J2:J" & VelocityLastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Velocity").Sort
 .SetRange Range("A1:N" & VelocityLastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .Apply
 End With
 Sheets("Velocity").Range("V2:V" & VelocityLastRow).Formula = "=CONCATENATE(A2,I2)"
 Sheets("Velocity").Range("V2:V" & VelocityLastRow).Value = Sheets("Velocity").Range("V2:V" & VelocityLastRow).Value
 LastRow = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Main Tab").Range("U2:U" & LastRow).Formula = "=CONCATENATE(E2,C2)"
 Sheets("Main Tab").Range("U2:U" & LastRow).Value = Sheets("Main Tab").Range("U2:U" & LastRow).Value
 Sheets("Main Tab").Range("T2:W" & LastRow).Value = Sheets("Main Tab").Range("T2:W" & LastRow).Value
 ActiveWorkbook.Worksheets("Main Tab").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Main Tab").Sort.SortFields.Add Key:=Range( _
 "U2:U" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Main Tab").Sort
 .SetRange Range("A1:AU" & LastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .Apply
 End With
 Sheets("Main Tab").Range("I2:I" & LastRow).Formula = "=IF(H2<>0,F2/H2)"
 Sheets("Main Tab").Range("J2:J" & LastRow).Formula = "=IF(VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J2ドル:K$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(U2,D2,CalculateWeek), VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J2ドル:K$" & VelocityLastRow & ",2,TRUE), ""Missing"")"
 Sheets("Main Tab").Range("K2:K" & LastRow).Formula = "=IF(VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(U2,D2,CalculateWeek), VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",5,TRUE), ""Missing"")"
 Sheets("Main Tab").Range("L2:L" & LastRow).Formula = "=IF(AND(K2<>0,I2>K2),ROUND((F2/K2)/J2,0.1),"""")"
 Sheets("Main Tab").Range("M2:M" & LastRow).Formula = "=IF(AND(F2>0,L2<>""""),L2-H2,"""")"
 Sheets("Main Tab").Range("N2:N" & LastRow).Formula = "=IF(AND(L2>0,L2<>"""",M2<>""""),FLOOR(M2/IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",3,TRUE), ""Missing""),1),"""")"
 Sheets("Main Tab").Range("O2:O" & LastRow).Formula = "=IF(AND(N2>IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""),N2)"
 Sheets("Main Tab").Range("I2:O" & LastRow).Value = Sheets("Main Tab").Range("I2:O" & LastRow).Value
 Sheets("Main Tab").Range("Z2:Z" & LastRow).Formula = "=ROUND((N2*K2),0)"
 Sheets("Main Tab").Range("Z2:Z" & LastRow).Value = Sheets("Main Tab").Range("Z2:Z" & LastRow).Value
 ActiveWorkbook.Worksheets("Main Tab").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Main Tab").Sort.SortFields.Add Key:=Range( _
 "Z2:Z" & LastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Main Tab").Sort
 .SetRange Range("A1:AU" & LastRow)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .Apply
 End With
 Sheets("Main Tab").Range("X2:X" & LastRow).Formula = "=INDEX('Quantity Available'!$D2ドル:$D$" & LastRowAvail & ",MATCH(U2&""LIBERTY"",'Quantity Available'!$F2ドル:$F$" & LastRowAvail & ",FALSE))"
 Sheets("Main Tab").Range("X2:X" & LastRow).Value = Sheets("Main Tab").Range("X2:X" & LastRow).Value
 Dim i As Long
 Dim j As Long
 Dim myval1 As Long
 Dim myval2 As Long
 Dim myval3 As Long
 Dim MyRange1 As Range
 Dim MyRange2 As Range
 Dim MyRange3 As Range
 For i = 2 To LastRow
 Set MyRange1 = Worksheets("Main Tab").Range("U1:U" & i)
 Set MyRange2 = Worksheets("Main Tab").Range("Z1:Z" & i)
 Set MyRange3 = Worksheets("Main Tab").Range("X" & i)
 myval1 = Application.WorksheetFunction.SumIf(MyRange1, Range("U" & i).Value, MyRange2)
 myval2 = MyRange3
 myval3 = myval2 - myval1
 Worksheets("Main Tab").Cells(i, 18).Value = myval3
 Next
 Sheets("Main Tab").Range("S2:S" & LastRow) = "LIBERTY"
 Sheets("Main Tab").Range("AC2:AC" & LastRow).Formula = "=IF(R2<0,""C"","""")"
 Sheets("Main Tab").Range("AC2:AC" & LastRow).Value = Sheets("Main Tab").Range("AC2:AC" & LastRow).Value
 Sheets("Main Tab").Range("AB2:AB" & LastRow).Formula = "=IF(AND(Z2>VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!$J2ドル:$N$" & VelocityLastRow & ",4), Z2<>""""),VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!$J2ドル:$N$" & VelocityLastRow & ",4),Z2)"
 Sheets("Main Tab").Range("AB2:AB" & LastRow).Value = Sheets("Main Tab").Range("AB2:AB" & LastRow).Value
 Sheets("Main Tab").Range("AA2:AA" & LastRow).Formula = "=IF(AC2=""C"",0,AB2)"
 Sheets("Main Tab").Range("AA2:AA" & LastRow).Value = Sheets("Main Tab").Range("AA2:AA" & LastRow).Value
 Dim myval4 As Long
 Dim MyRange4 As Range
 Dim MyRange5 As Range
 For j = 2 To 500 ' LastRow
 Set MyRange4 = Worksheets("Main Tab").Range("A2:A" & LastRow)
 Set MyRange5 = Worksheets("Main Tab").Range("AA2:AA" & LastRow)
 myval4 = Application.WorksheetFunction.SumIf(MyRange4, Range("A" & j).Value, MyRange5)
 Worksheets("Main Tab").Cells(j, 31).Value = myval4
 Next
 LastRowCorrection = Null
 LastRowAvail = Null
 VelocityLastRow = Null
 LastRowData = Null
 LastRow = Null
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
 Application.CutCopyMode = False
 LastRow = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Main Tab").Range("AI2:AI" & LastRow).Formula = "=IF($E2="""","""",INDEX(Velocity!G:G,MATCH('Main Tab'!E2,Velocity!A:A,FALSE)))"
 Sheets("Main Tab").Range("AR2:AR" & LastRow).Formula = "=IF($F2=0,0,ROUND((((($F2/$K2)/$J2)-$H2)/AI2),0.1))"
 Sheets("Main Tab").Range("AH2:AH" & LastRow).Formula = "=IF($K2=0,0,IF($F2=0,0,ROUND((((($F2/$K2)/$J2)-$H2)/AI2)*$K2,0.1)))"
 Sheets("Main Tab").Range("AG2:AG" & LastRow).Formula = "=IF(AH2<0,0,AH2)"
 Sheets("Main Tab").Range("AK2:AK" & LastRow).Formula = "=IF($A2="""","""",1+CalculateWeek)"
 Sheets("Main Tab").Range("AL2:AL" & LastRow).Formula = "=IF(AK2="""","""",CONCATENATE($E2,AK2))"
 Sheets("Main Tab").Range("AM2:AM" & LastRow).Formula = "=INDEX(Velocity!C:C,MATCH('Main Tab'!AL2,Velocity!V:V,FALSE))"
 Sheets("Main Tab").Range("AN2:AN" & LastRow).Formula = "=IF(K2=0,0,IF(AM2=0,0,ROUND((((($F2/$K2)*AM2)-$F2)-($H2-$F2))/AI2,0.1)))"
 Sheets("Main Tab").Range("AO2:AO" & LastRow).Formula = "=IF(AN2="""","""",IF(AN2<0,0,AN2))"
 Sheets("Main Tab").Range("AP2:AP" & LastRow).Formula = "=IF(AO2="""","""",AO2-AG2)"
 Sheets("Main Tab").Range("AS2:AS" & LastRow).Formula = "=IF(K2<$AR1,0,ドルIF($AR2<0,"""",$AR2))"
 Sheets("Main Tab").Range("AF2:AF" & LastRow).Formula = "=IF(K2>$AR1,ドルAS2,MAX(AG2,AO2))"
 Sheets("Main Tab").Range("AU2:AU" & LastRow).Formula = "=IF(AE2<Parameters!$B7,0,ドル'Main Tab'!AA2)"
 Sheets("Main Tab").Range("AT2:AT" & LastRow).Formula = "=CONCATENATE(A2,V2,AU2)"
 Sheets("Main Tab").Range("AA2:AU" & LastRow).Value = Sheets("Main Tab").Range("AA2:AU" & LastRow).Value
 Application.CutCopyMode = False
 LastRowCorrection = Null
 LastRow = Null
 MainTabLastColum = Null
 QuantityLastColumn = Null
End Sub
Sub GenDoc_Click()
 DisableOptimize
 LastRow = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 With ActiveWorkbook.Worksheets("Main Tab")
 .AutoFilterMode = False
 With .Range("A1:AU1")
 .AutoFilter
 .AutoFilter Field:=29, Criteria1:="<>C"
 .AutoFilter Field:=47, Criteria1:="<>0"
 End With
 End With
 Set rData = Sheets("Main Tab").Range("A2:A" & LastRow) 'change this to suit your needs
 Set rVis = rData.SpecialCells(xlCellTypeVisible)
 rVis.Copy
 Sheets("Order Upload").Select
 Sheets("Order Upload").Range("A2").Select
 ActiveSheet.Paste
 LastRowUpload = Sheets("Order Upload").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Set rData = Sheets("Main Tab").Range("B2:B" & LastRow) 'change this to suit your needs
 Set rVis = rData.SpecialCells(xlCellTypeVisible)
 rVis.Copy
 Sheets("Order Upload").Select
 Sheets("Order Upload").Range("J2").Select
 ActiveSheet.Paste
 Set rData = Sheets("Main Tab").Range("S2:S" & LastRow) 'change this to suit your needs
 Set rVis = rData.SpecialCells(xlCellTypeVisible)
 rVis.Copy
 Sheets("Order Upload").Select
 Sheets("Order Upload").Range("B2").Select
 ActiveSheet.Paste
 Set rData = Sheets("Main Tab").Range("E2:E" & LastRow) 'change this to suit your needs
 Set rVis = rData.SpecialCells(xlCellTypeVisible)
 rVis.Copy
 Sheets("Order Upload").Select
 Sheets("Order Upload").Range("E2").Select
 ActiveSheet.Paste
 Set rData = Sheets("Main Tab").Range("AU2:AU" & LastRow) 'change this to suit your needs
 Set rVis = rData.SpecialCells(xlCellTypeVisible)
 rVis.Copy
 Sheets("Order Upload").Select
 Sheets("Order Upload").Range("F2").Select
 ActiveSheet.Paste
 Sheets("AOS Info").Select
 LastRowAOS = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Order Upload").Select
 LastRowOrder = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 VelocityLastRow = Sheets("Velocity").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Range("C2:C" & LastRowOrder).Formula = "=ShpDt"
 Range("D2:D" & LastRowOrder).Formula = "=PONumber"
 Range("G2:G" & LastRowOrder).Formula = "=VLOOKUP(E2,'AOS Info'!$D2ドル:$E$" & LastRowAOS & ",2,FALSE)"
 Range("H2:H" & LastRowOrder).Formula = "=VLOOKUP(E2,'Velocity'!$A2ドル:$G$" & VelocityLastRow & ",7,FALSE)"
 Range("I2:I" & LastRowOrder).Formula = "=H2*F2"
 Sheets("Order Upload").Range("C2:D" & LastRowOrder).Value = Sheets("Order Upload").Range("C2:D" & LastRowOrder).Value
 Sheets("Order Upload").Range("G2:I" & LastRowOrder).Value = Sheets("Order Upload").Range("G2:I" & LastRowOrder).Value
 Sheets("Order Upload").Range("K2:K" & LastRowOrder).Formula = "=IF(B2="""",LEFT(J2,1),B2)"
 Sheets("Order Upload").Range("K2:K" & LastRowOrder).Value = Sheets("Order Upload").Range("K2:K" & LastRowOrder).Value
 ActiveWorkbook.Worksheets("Order Upload").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Order Upload").Sort.SortFields.Add Key:=Range( _
 "A2:A" & LastRowOrder), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 ActiveWorkbook.Worksheets("Order Upload").Sort.SortFields.Add Key:=Range( _
 "B2:B" & LastRowOrder), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
 xlSortNormal
 With ActiveWorkbook.Worksheets("Order Upload").Sort
 .SetRange Range("A1:K" & LastRowOrder)
 .Header = xlYes
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 LastRowCorrection = Null
 LastRowTransfer = Null
 LastRowMain = Null
 'SecondsElapsed = Round(Timer - StartTime, 2)
 'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 'StartTime = 0
 'Sheets("Main Tab").Select
 'ActiveSheet.ShowAllData
End Sub
Sub DisableOptimize()
'Disable As Copying Reenable at end
 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False
 Application.Calculation = xlCalculationManual
 Application.EnableEvents = False
End Sub
Sub EnableOptimize()
'Disable As Copying Reenable at end
 Application.ScreenUpdating = True
 Application.DisplayStatusBar = True
 Application.Calculation = xlCalculationAutomatic
 Application.EnableEvents = True
 Application.CutCopyMode = False
End Sub
Sub UnfilterAll()
Dim ws As Worksheet
On Error Resume Next
For Each ws In ThisWorkbook.Worksheets
 If ws.Visible Then ws.ShowAllData
Next ws
On Error GoTo 0
End Sub
Sub SkuDCSummary()
 Worksheets("SKU-DC SUmmary").Select
 DisableOptimize
 'Dim StartTime As Double
 'Dim SecondsElapsed As Double
 'StartTime = Timer
 Worksheets("Main Tab").AutoFilterMode = False
 LastRowMain = Sheets("Main Tab").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("Main Tab").Range("E1:E" & LastRowMain).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("SKU-DC Summary").Range("B1"), Unique:=True
 Sheets("Main Tab").Range("U1:U" & LastRowMain).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("SKU-DC Summary").Range("O1"), Unique:=True
 LastRowSKU = Sheets("SKU-DC Summary").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 LastRowAOS = Sheets("AOS Info").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 Sheets("SKU-DC Summary").Range("A2:A" & LastRowSKU).Formula = "=INDEX('Main Tab'!$C2ドル:$C$" & LastRowMain & ",MATCH(B2,'Main Tab'!$E2ドル:$E$" & LastRowMain & ",FALSE))"
 Sheets("SKU-DC Summary").Range("C2:C" & LastRowSKU).Formula = "=INDEX('AOS Info'!$E2ドル:$E$" & LastRowAOS & ",MATCH(B2,'AOS Info'!$A2ドル:$A$" & LastRowAOS & ",FALSE))"
 Sheets("SKU-DC Summary").Range("D2:D" & LastRowSKU).Formula = "=INDEX('AOS Info'!$B2ドル:$B$" & LastRowAOS & ",MATCH(B2,'AOS Info'!$A2ドル:$A$" & LastRowAOS & ",FALSE))"
 Dim myval1 As Long
 Dim MyRange1 As Range
 Dim MyRange2 As Range
 'Dim MyRange3 As Range
 'Dim MyRange4 As Range
 For j = 2 To LastRowSKU
 Set MyRange1 = Worksheets("Main Tab").Range("U2:U" & LastRowMain)
 Set MyRange2 = Worksheets("Main Tab").Range("F2:F" & LastRowMain)
 'Set MyRange3 = Worksheets("Main Tab").Range("E2:E" & LastRowMain)
 'Set MyRange4 = Worksheets("Main Tab").Range("E2:E" & LastRowMain)
 myval1 = Application.WorksheetFunction.SumIf(MyRange1, Range("O" & j).Value, MyRange2)
 Worksheets("SKU-DC Summary").Cells(j, 5).Value = myval1
 Next
 'Sheets("SKU-DC Summary").Range("E2:E" & LastRowSKU).Formula = "=SUMIFS('Main Tab'!$F2:$F$" & LastRowMain & ",'Main Tab'!$C2:$C$" & LastRowMain & ",A2,'Main Tab'!$E2:$E$" & LastRowMain & ",B2)"
 Sheets("SKU-DC Summary").Range("F2:F" & LastRowSKU).Formula = "=E2/COUNTIFS('Main Tab'!$E2:$E$" & LastRowMain & ",B2,'Main Tab'!$H2:$H$" & LastRowMain & ","">0"")"
 Sheets("SKU-DC Summary").Range("A2:F" & LastRowSKU).Value = Sheets("SKU-DC Summary").Range("A2:F" & LastRowSKU).Value
 Sheets("SKU-DC Summary").Range("G2:G" & LastRowSKU).Formula = "=COUNTIFS('Main Tab'!$C2:$C$" & LastRowMain & ",A2,'Main Tab'!$E2:$E$" & LastRowMain & ",B2,'Main Tab'!$H2:$H$" & LastRowMain & ","">0"")"
 For j = 2 To LastRowSKU
 Set MyRange1 = Worksheets("Main Tab").Range("E2:E" & LastRowMain)
 Set MyRange2 = Worksheets("Main Tab").Range("H2:H" & LastRowMain)
 'Set MyRange3 = Worksheets("Main Tab").Range("E2:E" & LastRowMain)
 'Set MyRange4 = Worksheets("Main Tab").Range("E2:E" & LastRowMain)
 myval1 = Application.WorksheetFunction.SumIf(MyRange1, Range("B" & j).Value, MyRange2)
 Worksheets("SKU-DC Summary").Cells(j, 8).Value = myval1 - Range("E" & j).Value
 Next
 'Sheets("SKU-DC Summary").Range("H2:H" & LastRowSKU).Formula = "=SUMIF('Main Tab'!$E2ドル:$E$" & LastRowMain & ",B2,'Main Tab'!$H2ドル:$H$" & LastRowMain & ")-E2"
 'Sheets("SKU-DC Summary").Range("G2:H" & LastRowSKU).Value = Sheets("SKU-DC Summary").Range("G2:H" & LastRowSKU).Value
 Sheets("SKU-DC Summary").Range("I2:I" & LastRowSKU).Formula = "=H2/G2"
 Sheets("SKU-DC Summary").Range("J2:J" & LastRowSKU).Formula = "=E2/(H2+E2)"
 Sheets("SKU-DC Summary").Range("I2:J" & LastRowSKU).Value = Sheets("SKU-DC Summary").Range("I2:J" & LastRowSKU).Value
 'Sheets("SKU-DC Summary").Range("O2:O" & LastRowSKU).Formula = "=B2 & A2"
 Sheets("SKU-DC Summary").Range("O2:O" & LastRowSKU).Value = Sheets("SKU-DC Summary").Range("O2:O" & LastRowSKU).Value
 For j = 2 To LastRowSKU
 Set MyRange1 = Worksheets("Main Tab").Range("U2:U" & LastRowMain)
 Set MyRange2 = Worksheets("Main Tab").Range("AU2:AU" & LastRowMain)
 myval1 = Application.WorksheetFunction.SumIf(MyRange1, Range("O" & j).Value, MyRange2)
 Worksheets("SKU-DC Summary").Cells(j, 11).Value = myval1
 Next
 For j = 2 To LastRowSKU
 Set MyRange1 = Worksheets("Main Tab").Range("U2:U" & LastRowMain)
 Set MyRange2 = Worksheets("Main Tab").Range("AU2:AU" & LastRowMain)
 myval1 = Application.WorksheetFunction.SumIf(MyRange1, Range("O" & j).Value, MyRange2)
 Worksheets("SKU-DC Summary").Cells(j, 13).Value = myval1
 Next
 Sheets("SKU-DC Summary").Range("K2:O" & LastRowSKU).Value = Sheets("SKU-DC Summary").Range("K2:O" & LastRowSKU).Value
 EnableOptimize
 LastRowCorrection = Null
 LastRowTransfer = Null
 LastRowMain = Null
 'SecondsElapsed = Round(Timer - StartTime, 2)
 'MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 'StartTime = 0
End Sub
Sub RunAll()
Dim StartTime As Double
 Dim SecondsElapsed As Double
 StartTime = Timer
Call Clear_Click
Call LoadMicroData2
Call Calculate_Click
Call GenDoc_Click
Call SkuDCSummary
SecondsElapsed = Round(Timer - StartTime, 2)
 MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 StartTime = 0
End Sub
Jamal
35.2k13 gold badges134 silver badges238 bronze badges
asked Feb 24, 2017 at 18:42
\$\endgroup\$
6
  • 2
    \$\begingroup\$ Have you considered making changes and timing the results? \$\endgroup\$ Commented Feb 24, 2017 at 18:48
  • \$\begingroup\$ That's a good idea. I've done that for MatLab code back in school, but didn't even think about that being a functionality of Excel. It takes 2 hours to run in full for 500 lines, but I'll try timing each section and running it independently. \$\endgroup\$ Commented Feb 24, 2017 at 18:51
  • 2
    \$\begingroup\$ Excel 32-bit has explicit limitations on file size that 64-bit does not. \$\endgroup\$ Commented Feb 24, 2017 at 19:17
  • 2
    \$\begingroup\$ Especially in the loops, pull the worksheet data from the cells into a memory array instead of working directly on the worksheet. That will give you a huge speed-up in your code. \$\endgroup\$ Commented Feb 24, 2017 at 20:57
  • 1
    \$\begingroup\$ The current question title, which states your concerns about the code, applies to too many questions on this site to be useful. The site standard is for the title to simply state the task accomplished by the code. Please see How to Ask for examples, and revise the title accordingly. \$\endgroup\$ Commented Mar 4, 2017 at 5:04

1 Answer 1

6
\$\begingroup\$

Oh, please forgive me if my tone come across abrasive - I know you're just trying to maintain and learn, which is why I bring this all up! Don't feel bad, I'm self-taught too and if I ran into that thing, I could not have fixed it when I started learning.


First things first, variables. Please use them. Right now the whole thing seems overwhelming because it is.

dim orderSheet as Worksheet
set orderSheet = Sheets("Order Upload")
'etc for the rest
Sheets("Main Tab")
Sheets("Microstrategy Data")
Sheets("Velocity")
Sheets("Quantity Available")

OR

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet and you won't even have to declare variables!


Formulas, do you need to print them on the sheet?

Sheets("Main Tab").Range("AC2:AC" & LastRow).Formula = "=IF(R2<0,""C"","""")"

Why not make the calculation and then print that to the sheet? Or do you need them?


Dim MyRange4 As Range
Dim MyRange5 As Range

Goodness, what are these? Ranges? Doing what? Variable names - give your variables meaningful names. For instance:

For j = 2 To 500 ' LastRow
 Set MyRange4 = Worksheets("Main Tab").Range("A2:A" & LastRow)
 Set MyRange5 = Worksheets("Main Tab").Range("AA2:AA" & LastRow)
 myval4 = Application.WorksheetFunction.SumIf(MyRange4, Range("A" & j).Value, MyRange5)
 Worksheets("Main Tab").Cells(j, 31).Value = myval4
Next

I can't imagine what's going on here without going back through the entire module and figuring out what each thing is. Wouldn't it be easier to follow with something like:

For index = 2 To lastrow
 Set quantities = MainTab.Range("quantities")
 Set prices = MainTab.Range("prices")
 cost = 1 'calculation
 CostSheet.Range("total") = cost
Next

Or better yet, arrays. But one step at a time. Try refactoring all the hard-coded ranges and sheets into variables. Either CodeNames and Named Ranges or a range variable describing what the range is.

Speed

Formulas

If I search the macro for the word "formula" I come up with 53 hits. That's 53 different times you've set a formula. And many of those formulas are for more than one cell in a range. Of course excel will hang when calculations are turned back on - imagine how many calculations that is. If you can use values instead of formulas, please do. If not - please tell us why.

Loops

I see seven loops

For i = 2 to lastRow
For j = 2 to lastRow
For Each ws in thisworkbook.sheets
For j = 2 to LastRowSKU
For j = 2 to LastRowSKU
For j = 2 to LastRowSKU
For j = 2 to LastRowSKU

See those last 4? Or even all 6? Why are you iterating over that four separate times? Why not do everything in the single loop?


You also have

If lastRow > 1 Then

Five times.. in a row! Seems to me you could pull a function out of there for refactoring.

Also, speaking of lastrow - There is a standard way to find lastRow and lastColumn. That post explains why.


Example

You pointed to

Sheets("Main Tab").Range("O2:O" & LastRow).Formula = "=IF(AND(N2>IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""),N2)"

as a single formula, right?

Const LOOKUP_MATCH as String = "Missing"
Dim lookupString as string
lookupString = CONCATENATE(E2,C2,D2,CalculateWeek)
dim velocityLookupRange as Range
set velocityLookupRange = Velocity.Range(cells(2,10),cells(lastRow,13))
dim lookupCell as Range
Set lookupCell = Range("N2")
Dim returnColumn as Long
ReturnColumn = 4

The formula would now be

MainTab("O2:O" & LastRow).Formula = "=IF(AND(LOOKUPCELL>IF(VLOOKUP(LookupString),VelocityLookupRange,1,1)=LookupString), VLOOKUP(LookupString),VelocityLookupRange,returnColumn,1), LOOKUP_MATCH), LOOKUPCELL<>""""),IF(VLOOKUP(LookupString),VelocityLookupRange,1,1)=LookupString), VLOOKUP(LookupString),VelocityLookupRange,returnColumn,1), LOOKUP_MATCH),LOOKUPCELL)"

Still overwhelming! Let's get out Notepad++ to figure this thing out:

Sheets("Main Tab").Range("O2:O" & LastRow).Formula =

=IF(
 AND(
 N2>IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), 
 N2<>""""),
 THEN 
 IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",4,TRUE), ""Missing"")
 ELSE:
 ,N2)

I think boils down to (in VBA)

IF NOT N2 = vbNullString Then
 if N2 > someResult then
 someResult
 end if
 Else: MISSING
end if

With

dim someResult as String
someResult = VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J2ドル:N$" & VelocityLastRow & ",1,TRUE) = lookupString

I'm still not sure I got that right. How can you debug this? Is the error because it's taking forever to calculate or because the formula string is too many characters? Or is there a missing result?

answered Feb 25, 2017 at 20:46
\$\endgroup\$
4
  • \$\begingroup\$ Thank you very much! I'll probably have tons of questions, but for now I'll work my way through these improvements. Then when I ask a question I can post the new and improved (hopefully) code with annotations and defined variables! \$\endgroup\$ Commented Feb 26, 2017 at 17:48
  • \$\begingroup\$ Definitely. Even if you just make a few improvements, you can always post again for more suggestions. There are a lot of people here that can offer different opinions and ideas! \$\endgroup\$ Commented Feb 26, 2017 at 17:48
  • \$\begingroup\$ I think (and please correct me if I'm wrong) you messed up the quotes on the Example block. There are some literals being considered as variables and vice-versa. E.g. the formula in the "The formula would now be" part is all literals instead of consider the variables and the very last line doesn't seem right \$\endgroup\$ Commented Feb 27, 2017 at 20:34
  • \$\begingroup\$ @VictorMoraes the formula is using VBA variables, just to try to illustrate the point. \$\endgroup\$ Commented Feb 27, 2017 at 20:42

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.