ExcelChampion
Well-known Member
- Joined
- Aug 12, 2005
- Messages
- 976
I have an odd situation that has plagued me for several weeks without resolution. The code below (which is still in rough draft mode), when I run it on the machines I have, takes about four minutes to complete. However, when I email to the gentleman that will be using it he says it either hangs or takes about nine hours to complete. He says he's tried it on a few machines with the same result. He's tried it on work computers as well as his personal PC.
What in the world could cause such a discrepancy?
PS, the data set that it manipulates is around 60K records. As well, I know I have some lookups in there that cause the long run times, but what I would like to know why is it only 4 minutes when I run it and 9 hours when he runs it?
What in the world could cause such a discrepancy?
PS, the data set that it manipulates is around 60K records. As well, I know I have some lookups in there that cause the long run times, but what I would like to know why is it only 4 minutes when I run it and 9 hours when he runs it?
Code:
Sub mcr_RunRF()
Dim lRow As Long
Dim col As Integer, x As Integer
strttime = Time
With Sheets("Input")
r5 = 0
r4 = .Range("C6").Value + 1
r3 = .Range("C7").Value + 1
r2 = .Range("C8").Value + 1
r1 = .Range("C9").Value + 1
f5 = .Range("E13").Value
f4 = .Range("E14").Value
f3 = .Range("E15").Value
f2 = .Range("E16").Value
f1 = .Range("E17").Value
m5 = .Range("C13").Value
m4 = .Range("C14").Value
m3 = .Range("C15").Value
m2 = .Range("C16").Value
m1 = .Range("C17").Value
Cust0 = 0
Application.Calculation = xlCalculationManual
.Select
.Range("C20").FormulaR1C1 = "Please Wait…"
.Range("C20").Font.ColorIndex = 3
End With
Application.ScreenUpdating = False
Sheets("Raw Data").Cells.Copy
With Sheets("List")
.Select
.Range("A1").PasteSpecial
.Range("A:C").EntireColumn.Insert
.Range("A1").Value = "Action Needed"
.Range("B1").Value = "R"
.Range("C1").Value = "F"
.Range("AM1").Value = "M"
Sheets("Input").Range("G16").Value = Evaluate("=MOD(Input!$G$16,106)+1")
lRow = .Range("P" & Cells.Rows.Count).End(xlUp).Row
.Range("B2:B" & lRow) = _
"=VLOOKUP(Input!R1C3-List!RC[14],{" & Val(r5) & ",5;" & Val(r4) & ",4;" & Val(r3) & ",3;" & Val(r2) & ",2;" & Val(r1) & ",1},2)"
.Range("C2:C" & lRow) = _
"=VLOOKUP(RC[26],{" & Val(Cust0) & ",0;" & Val(f1) & ",1;" & Val(f2) & ",2;" & Val(f3) & ",3;" & Val(f4) & ",4;" & Val(f5) & ",5},2)"
.Range("AM2:AM" & lRow) = _
"=VLOOKUP(RC30,{" & Val(Cust0) & ",0;" & Val(m1) & ",1;" & Val(m2) & ",2;" & Val(m3) & ",3;" & Val(m4) & ",4;" & Val(m5) & ",5},2)"
.Range("B2:AM" & lRow).Copy
.Range("B2:AM" & lRow).PasteSpecial (xlPasteValues)
.Range("A1:AM" & lRow).Sort Key1:=.Range("C2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1
.Columns("AM:AM").Cut
.Columns("D:D").Insert Shift:=xlToRight
.Columns("E:E").Insert Shift:=xlToRight
.Range("E1") = "MFR"
.Range("E2:E" & lRow) = "=RC[-1]&RC[-2]&RC[-3]"
.Columns("E:E").NumberFormat = "@"
.Range("E2:E" & lRow).Value = .Range("E2:E" & lRow).Value
Range("A2:A" & lRow).FormulaR1C1 = "=IF(RC[4]<=Input!R13C7,"""",IF(AND(--(RC17)>=Input!R3C3,--(RC32)>=Input!R14C7,RC19=""""),""New1"",IF(AND(--(RC18)>=Input!R3C3,--(RC17)>=TODAY()-180,--(RC32)>=Input!R15C7,RC20=""""),""New2"",IF(AND(--(RC[42])<=-10,--(RC[42])>-100),""X"",IF(--(RC[42])<=-100,""XX"",VLOOKUP(RC[3]-RC[2],{-1,""R-1"";-2,""R-2"";-3,""R-3"";-4,""R-4""},2,0))))))"
Range("A2:A" & lRow).Value = Range("A2:A" & lRow).Value
Range("A1").AutoFilter Field:=1, Criteria1:="=New1", Operator:=xlOr, Criteria2:="=New2"
Range("A1").SpecialCells(xlCellTypeVisible).Copy
Sheets("New").Range("A1").PasteSpecial
Range("AS2:AS" & Range("G" & Range("A:A").Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible) = "x"
Range("A1").AutoFilter
If Range("AS" & Range("A:A").Count).End(xlUp).Row <> 1 Then
Columns("A:AS").Sort Key1:=Range("AS2"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Range("AS2"), Range("AS2").End(xlDown)).EntireRow.Delete
End If
.Range("A1").AutoFilter Field:=3, Criteria1:="0"
.Range(.Range("A1:AN1"), .Range("A1:AN1").End(xlDown)).Copy
Sheets("Cust 0").Select
Range("A1").PasteSpecial
.Select
Range("AS2:AS" & Range("G" & Range("A:A").Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible) = "x"
Range("A1").AutoFilter
If Range("AS" & Range("A:A").Count).End(xlUp).Row <> 1 Then
Columns("A:AS").Sort Key1:=Range("AS2"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Range("AS2"), Range("AS2").End(xlDown)).EntireRow.Delete
End If
.Range("A1").AutoFilter Field:=4, Criteria1:="0"
.Range(.Range("A1"), .Range("AN1").End(xlDown)).Copy
Sheets("Cust 0").Select
Cust_lRow0 = Range("H" & Range("A:A").Rows.Count).End(xlUp).Offset(1, 0).Row
Range("A" & Cust_lRow0).PasteSpecial
Rows(Cust_lRow0).Delete
.Select
Range("AS2:AS" & Range("G" & Range("A:A").Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible) = "x"
Range("A1").AutoFilter
If Range("AS" & Range("A:A").Count).End(xlUp).Row <> 1 Then
Columns("A:AS").Sort Key1:=Range("AS2"), Order1:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range(Range("AS2"), Range("AS2").End(xlDown)).EntireRow.Delete
End If
With Range("AO1")
.FormulaR1C1 = "Random Number"
.HorizontalAlignment = xlCenter
.Characters(Start:=1, Length:=13).Font.FontStyle = "Bold"
End With
lRow = .Range("R" & Cells.Rows.Count).End(xlUp).Row
Range("AP2:AP" & lRow).FormulaR1C1 = "=VLOOKUP(RC6,Input!R4C10:R23C10,1,0)"
Range("AP2:AP" & lRow).Value = Range("AP2:AP" & lRow).Value
ActiveSheet.AutoFilterMode = False
Range("A:AP").AutoFilter
Selection.AutoFilter Field:=42, Criteria1:="<>#N/A", Operator:=xlAnd
Range("AP1").End(xlDown).Select
Range(Selection, Selection.End(xlDown)).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
Range("AP:AP").Delete
lRow = .Range("R" & Cells.Rows.Count).End(xlUp).Row
.Range("AP2:AP" & lRow) = "=INDEX(Historical!C2:C107,MATCH(List!RC6,Historical!C1,0),MATCH(Input!R16C7,Historical!R1,0))"
.Range("AP2:AP" & lRow).Value = .Range("AP2:AP" & lRow).Value
.Range("A:AP").AutoFilter Field:=42, Criteria1:="=#N/A", Operator:=xlAnd
Sheets("Historical").Select
HlRow = Range("A" & Cells.Rows.Count).End(xlUp).Row
Range("DD2:DD" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Offset(0, -(Sheets("Input").Range("G16").Value)) = "=INDEX(List!C5,MATCH(Historical!RC1,List!C6,0))"
Range("DD2:DD" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Offset(0, -(Sheets("Input").Range("G16").Value)).Value = Range("DD2:DD" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Offset(0, -(Sheets("Input").Range("G16").Value)).Value
Cells.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
.Range(.Range("F1"), .Range("F1").End(xlDown)).Copy
Range("A" & HlRow).Offset(1, 0).PasteSpecial
If ActiveCell.Value = "CustomerID" Then ActiveCell.Delete
.Range(.Range("E1"), .Range("E1").End(xlDown)).Copy
Range("DD" & HlRow).Offset(1, -(Sheets("Input").Range("G16").Value)).PasteSpecial
If ActiveCell.Value = "MFR" Then ActiveCell.Delete
Range("DD" & HlRow).Offset(1, -(Sheets("Input").Range("G16").Value)).Value = Range("DD" & HlRow).Offset(1, -(Sheets("Input").Range("G16").Value)).Value * 1
Sheets("List").Select
ActiveSheet.AutoFilterMode = False
Range("AP1") = "Old MFR"
Range("AQ1") = "Delta"
.Range("AQ2:AQ" & lRow) = "=RC[-38]-RC[-1]"
.Range("AQ2:AQ" & lRow).Value = .Range("AQ2:AQ" & lRow).Value
.Columns("D:D").Cut
.Columns("B:B").Insert Shift:=xlToRight
.Columns("D:D").Cut
.Columns("C:C").Insert Shift:=xlToRight
.Range("A2:A" & lRow) = "=IF(RC[4]<=Input!R13C7,"""",IF(AND(--(RC[42])<=-10,--(RC[42])>-100),""X"",IF(--(RC[42])<=-100,""XX"",VLOOKUP(RC[3]-RC[2],{-1,""R-1"";-2,""R-2"";-3,""R-3"";-4,""R-4""},2,0))))"
.Range("A2:A" & lRow).Value = .Range("A2:A" & lRow).Value
.Range("AO2:AO" & lRow) = "=IF(ISERROR(RC[-40]),"""",IF(RC[-40]<>"""",RAND(),""""))"
.Range("AO2:AO" & lRow).Value = .Range("AO2:AO" & lRow).Value
.Range("A:AQ").Sort Key1:=.Range("A2"), Order1:=xlDescending, Key2:= _
.Range("AO2"), Order2:=xlDescending, Key3:=.Range("AP2"), Order3:= _
xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End With
Range("AR1") = "Action Type"
Range("AR2:AR" & Range("A" & Cells.Rows.Count).End(xlUp).Row).FormulaR1C1 = "=INDEX(Input!R27C4:R31C9,MATCH(List!RC2,Input!R27C3:R31C3,0),MATCH(List!RC1,Input!R26C4:R26C9,0))"
Range("AR2:AR" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Value = Range("AR2:AR" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Value
Columns("AR:AR").Cut
Range("B:B").Insert Shift:=xlToRight
Range("AS1").FormulaR1C1 = "Flagged Customer"
Range("AS2:AS" & Range("G" & Cells.Rows.Count).End(xlUp).Row).FormulaR1C1 = "=IF(SUMPRODUCT(--(RC[-38]=Input!R4C11:R23C12))>0,""X"","""")"
Range("AS2:AS" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Value = Range("AS2:AS" & Range("A" & Cells.Rows.Count).End(xlUp).Row).Value
Range("A1").CurrentRegion.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$AS1=""X"""
Selection.FormatConditions(1).Interior.ColorIndex = 3
Sheets("List").Range("F1").Value = Sheets("Input").Range("G16").Value
Range("AT2:AT" & Range("G" & Cells.Rows.Count).End(xlUp).Row).FormulaR1C1 = "=MATCH(RC[-39],Historical!C[-45],0)"
Range("AU2:AU" & Range("G" & Cells.Rows.Count).End(xlUp).Row).Resize(Range("G" & Cells.Rows.Count).End(xlUp).Row - 1, 106).FormulaR1C1 = "=INDEX(Historical!C[-45],List!RC46)"
Range("AT2:EV" & Range("G" & Cells.Rows.Count).End(xlUp).Row).Value = Range("AT2:EV" & Range("G" & Cells.Rows.Count).End(xlUp).Row).Value
Columns("AT:AT").Delete Shift:=xlToLeft
Range("AT1").FormulaR1C1 = "106"
Range("AU1:EU1").FormulaR1C1 = "=RC[-1]-1"
Range("AU1:EU1").Value = Range("AU1:EU1").Value
Range("EV1") = "Year to Year Avg Delta"
Range("EV2:EV" & Range("G" & Cells.Rows.Count).End(xlUp).Row).FormulaR1C1 = "=AVERAGE(OFFSET(RC152,0,-(Input!R16C7)):OFFSET(RC152,0,-(Input!R16C7-3)))-AVERAGE(OFFSET(RC152,0,-(Input!R16C7)-53):OFFSET(RC152,0,-(Input!R16C7-3)-53))"
Range("EV2:EV" & Range("G" & Cells.Rows.Count).End(xlUp).Row).Value = Range("EV2:EV" & Range("G" & Cells.Rows.Count).End(xlUp).Row).Value
Cells.Replace What:="#N/A", Replacement:=""
Range("A:EW").Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlDescending, Key3:=Range("E2"), Order3:=xlAscending, Header _
:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A:EW").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("EW2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
'Cells.EntireColumn.AutoFit
Range(Range("G1").End(xlDown).Offset(1, 0).Address & ":" & Range("G" & Cells.Rows.Count).Address).EntireRow.Delete
Sheets("List").Rows("1:1").Font.Size = 10
Sheets("List").Rows("1:1").Font.Bold = True
Sheets("List").Rows("1:1").HorizontalAlignment = xlCenter
Sheets("List").Range("A1").Select
Sheets("New").Select
Rows("1:1").Font.Size = 10
Rows("1:1").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
Cells.Replace What:="#N/A", Replacement:=""
Range("A:EW").Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlDescending, Key3:=Range("E2"), Order3:=xlAscending, Header _
:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A:EW").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("EW2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
'Cells.EntireColumn.AutoFit
Sheets("Cust 0").Select
Rows("1:1").Font.Size = 10
Rows("1:1").Font.Bold = True
Rows("1:1").HorizontalAlignment = xlCenter
Cells.Replace What:="#N/A", Replacement:=""
Range("A:EW").Sort Key1:=Range("C2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlDescending, Key3:=Range("E2"), Order3:=xlAscending, Header _
:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A:EW").Sort Key1:=Range("B2"), Order1:=xlAscending, Key2:=Range("EW2") _
, Order2:=xlDescending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
'Cells.EntireColumn.AutoFit
Sheets("Input").Select
Range("C20").Font.ColorIndex = 0
On Error Resume Next
ActiveWorkbook.SaveAs Filename:= _
ThisWorkbook.Path & "\RF Analysis " & Format(Date, "yymmdd") & ".xls", FileFormat:=xlNormal
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
endtime = Time
MsgBox "Done " & Format(endtime - strttime, "hh:mm:ss"), vbInformation, ""
End Sub