Macro Hangs or Takes A Long Time To Run

ExcelChampion

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?


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
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Sort by date Sort by votes
Hi ExcelChampion,

My guess would be that your friend's computer has too little RAM and possibly also too little virtual memory swap space available to perform the sorts efficiently, and the computer is "thrashing". Lots of times these problems can be solved by changing Windows configuration parameters to give the Excel application access to more of the computer's RAM (the system places a limit on the amount of RAM any one process can have, but this limit is settable). Ideally, you would want the entire Excel process for the workbook to fit entirely within RAM for the greatest efficiency.

I also suggest you have your friend execute the macro line-by-line in debug mode. That way he should be able to ascertain exactly where in the code the bottleneck is occurring (again, I suspect it would be one or more of the sort operations).

I hope this helps.

Damon
 
Upvote 0
Todd

What is the purpose of this code?

It seems to be a bit repetitive.

There's also a lot of unneeded selecting and unqualified range references.

Another thing, and this could be connected to the problem is code like this.
Code: 
Cells.Replace What:="#N/A", Replacement:=""
That's going to operate on all 16777216 cells in the worksheet, 17179869184 if it's being run in Excel 2007.:)
 
Upvote 0
Thanks, gentleman. You've pretty much stated what I thought as well.

Norie, yes, the code is in rough draft mode and it does have some redundancy that I need to clean up...as well as the extra selecting (this code has gone through a bunch of revisions). With that in mind, however, I don't think that would cause such a large discrepancy in run time.

The only thing I can think of is what Damon mentioned above. The thing is that he's tried it on 4 or 5 machines with the same result. I suppose I really need to ask him the specs of the machines.

As well, I already know that he doesn't have any add ins running, and he's mentioned that he has some security software running in the back ground, but I don't think that would cause this.

Norie, I will clean up the code a little bit more and see if that helps and I will find out his specs and post back.

Thanks.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Random selection modification not working
Replies
2
Views
171
Damian37
D
O
  • Solved
VBA: Deleting Visible rows using Auto Filter; Excluding Header
Replies
4
Views
416
mumps
mumps
Keebler
  • Solved
clean code
5 6 7
Replies
66
Views
1K
Keebler
Keebler
D
  • Solved
Range in worksheet1 Insert into worksheet2 from row 2
Replies
2
Views
178
dufusgoofus
D
D
  • Locked
  • Question
Range in worksheet1 Insert into worksheet2 from row 2
Replies
1
Views
184
Fluff
Fluff

Forum statistics

Threads
1,215,329
Messages
6,124,301
Members
449,149
Latest member
mwdbActuary

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top