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
-
2\$\begingroup\$ Have you considered making changes and timing the results? \$\endgroup\$Stephen Rauch– Stephen Rauch2017年02月24日 18:48:09 +00:00Commented 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\$Emily Alden– Emily Alden2017年02月24日 18:51:57 +00:00Commented Feb 24, 2017 at 18:51
-
2\$\begingroup\$ Excel 32-bit has explicit limitations on file size that 64-bit does not. \$\endgroup\$Raystafarian– Raystafarian2017年02月24日 19:17:08 +00:00Commented 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\$PeterT– PeterT2017年02月24日 20:57:14 +00:00Commented 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\$Jamal– Jamal2017年03月04日 05:04:14 +00:00Commented Mar 4, 2017 at 5:04
1 Answer 1
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?
-
\$\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\$Emily Alden– Emily Alden2017年02月26日 17:48:03 +00:00Commented 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\$Raystafarian– Raystafarian2017年02月26日 17:48:58 +00:00Commented 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\$Victor Moraes– Victor Moraes2017年02月27日 20:34:36 +00:00Commented Feb 27, 2017 at 20:34
-
\$\begingroup\$ @VictorMoraes the formula is using VBA variables, just to try to illustrate the point. \$\endgroup\$Raystafarian– Raystafarian2017年02月27日 20:42:12 +00:00Commented Feb 27, 2017 at 20:42