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!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2: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!J$2:K$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(U2,D2,CalculateWeek), VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J$2:K$" & VelocityLastRow & ",2,TRUE), ""Missing"")"
    Sheets("Main Tab").Range("K2:K" & LastRow).Formula = "=IF(VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(U2,D2,CalculateWeek), VLOOKUP(CONCATENATE(U2,D2,CalculateWeek),Velocity!J$2: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!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2: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!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2: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'!$D$2:$D$" & LastRowAvail & ",MATCH(U2&""LIBERTY"",'Quantity Available'!$F$2:$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!$J$2:$N$" & VelocityLastRow & ",4), Z2<>""""),VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!$J$2:$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<$AR$1,0,IF($AR2<0,"""",$AR2))"
    Sheets("Main Tab").Range("AF2:AF" & LastRow).Formula = "=IF(K2>$AR$1,AS2,MAX(AG2,AO2))"
    Sheets("Main Tab").Range("AU2:AU" & LastRow).Formula = "=IF(AE2<Parameters!$B$7,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'!$D$2:$E$" & LastRowAOS & ",2,FALSE)"
    Range("H2:H" & LastRowOrder).Formula = "=VLOOKUP(E2,'Velocity'!$A$2:$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'!$C$2:$C$" & LastRowMain & ",MATCH(B2,'Main Tab'!$E$2:$E$" & LastRowMain & ",FALSE))"

    Sheets("SKU-DC Summary").Range("C2:C" & LastRowSKU).Formula = "=INDEX('AOS Info'!$E$2:$E$" & LastRowAOS & ",MATCH(B2,'AOS Info'!$A$2:$A$" & LastRowAOS & ",FALSE))"

    Sheets("SKU-DC Summary").Range("D2:D" & LastRowSKU).Formula = "=INDEX('AOS Info'!$B$2:$B$" & LastRowAOS & ",MATCH(B2,'AOS Info'!$A$2:$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'!$E$2:$E$" & LastRowMain & ",B2,'Main Tab'!$H$2:$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
\$\endgroup\$
  • 2
    \$\begingroup\$ Have you considered making changes and timing the results? \$\endgroup\$ – Stephen Rauch Feb 24 '17 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 Feb 24 '17 at 18:51
  • 2
    \$\begingroup\$ Excel 32-bit has explicit limitations on file size that 64-bit does not. \$\endgroup\$ – Raystafarian Feb 24 '17 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 Feb 24 '17 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 Mar 4 '17 at 5:04
5
\$\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!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), N2<>""""),IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2: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!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",4,TRUE), ""Missing""), 
        N2<>""""),
    THEN    
        IF(VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2:N$" & VelocityLastRow & ",1,TRUE)=CONCATENATE(E2,C2,D2,CalculateWeek), VLOOKUP(CONCATENATE(E2,C2,D2,CalculateWeek),Velocity!J$2: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!J$2: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?

\$\endgroup\$
  • \$\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 Feb 26 '17 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 Feb 26 '17 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 Feb 27 '17 at 20:34
  • \$\begingroup\$ @VictorMoraes the formula is using VBA variables, just to try to illustrate the point. \$\endgroup\$ – Raystafarian Feb 27 '17 at 20:42

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.