Macro takes forever to run formulas

[chriscorpion786]

Hi All,

I have a workbook where i am extracting some rows and dumping it in the "RunMacros" worksheet. I then remove the duplicates and dump the data in the "Inventory"sheet. When running on the formulas, the macro runs forever, i have around 300,000 rows. Can you help to understand why is it taking so long, is there any other method to cut down the time taken.


Thanks in advance.

Chriscorpion786

Sub Inventory()'


Dim lastrow As Long




lastrow = Worksheets("SoldParts").Cells(Rows.Count, 6).End(xlUp).Row




Worksheets("Inventory").Activate


Rows("7:7").Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Delete shift:=xlUp



Sheets("SoldParts").Select
Range("F2:G" & lastrow).Copy Destination:=Sheets("RunMacros").Range("A2")

Sheets("RunMacros").Select


ActiveSheet.Range("A1:B" & lastrow).RemoveDuplicates Columns:=1, Header:= _
xlYes
Application.DisplayAlerts = True

Columns("A:B").Select
' ActiveWorkbook.Worksheets("RunMacros").Sort.SortFields.Clear
' ActiveWorkbook.Worksheets("RunMacros").Sort.SortFields.Add Key:=Range( _
' "A2:A1048000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
' xlSortNormal
With ActiveWorkbook.Worksheets("RunMacros").Sort
.SetRange Range("A1:B" & lastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Range("A2:B2").Select
Range(Selection, Selection.End(xlDown)).Copy Destination:=Sheets("Inventory").Range("I7")

' Sheets("Inventory").Select
' Range("I7").Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False

Range("H7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C17,13,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C17,13,FALSE)))"
Range("K7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,2,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,2,FALSE)))"
Range("L7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,8,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,8,FALSE)))"
Range("M7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,9,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,9,FALSE)))"
Range("N7").Select


Range("O7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,10,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,10,FALSE)))"
Range("P7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,11,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,11,FALSE)))"
Range("Q7").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC9="""","""",IF(ISNA(VLOOKUP(RC9,Stock!C4:C16,12,FALSE)),"""",VLOOKUP(RC9,Stock!C4:C16,12,FALSE)))"
Range("R7").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC9<>"""",SUMIF(SoldParts!C3,RC9&R6C18,SoldParts!C15)>0),SUMIF(SoldParts!C3,RC9&R6C18,SoldParts!C15),"""")"
Range("S7").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC9<>"""",SUMIF(SoldParts!C3,RC9&R6C19,SoldParts!C15)>0),SUMIF(SoldParts!C3,RC9&R6C19,SoldParts!C15),"""")"
Range("T7").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC9<>"""",SUMIF(SoldParts!C3,RC9&R6C20,SoldParts!C15)>0),SUMIF(SoldParts!C3,RC9&R6C20,SoldParts!C15),"""")"
Range("U7").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC9<>"""",SUMIF(SoldParts!C3,RC9&R6C21,SoldParts!C15)>0),SUMIF(SoldParts!C3,RC9&R6C21,SoldParts!C15),"""")"


Range("Inventory[#Headers]").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("H1").Select

End Sub

 

[Joe4]

VLOOKUP formulas are very labor intensive. If you are trying to do multiple VLOOKUP formulas on over 300,000, I suspect you are going to have huge performance issues. Something of this magnitude (matching over huge amounts of data with other data) sounds more like a database design to me, something that programs like Microsoft Access, SQL, MySQL, or Oracle are better equipped to handle.

A few minor things you can do to help a little (though I don't know how much it will help in your case, with the magnitude of your data) are the following:

1. Just about every ".SELECT" statement that is followed by a line starting with "SELECTION" or "ACTIVECELL" can usually be combined. Reducing/eliminating the number of SELECTs you have will help speed up your code, i.e.

[COLOR=#333333]Range("O7").Select[/COLOR]
[COLOR=#333333]ActiveCell.FormulaR1C1 = _[/COLOR]

can be combined to:

[COLOR=#333333]Range("O7").[/COLOR][COLOR=#333333]FormulaR1C1 = _[/COLOR]

2. Suppressing screen updates will speed up your code, i.e. place this line at the beginning of your code:

Application.ScreenUpdating=False

and place this line at the end of your code:

Application.ScreenUpdating=True

3. If you are using Excel 2007 or newer, make use of the IFERROR function, especially as it relates to VLOOKUP functions. It saves you have having to do the VLOOKUP twice (once to see if there is an error). See here: Excel IFERROR Function

Hope that helps.

 

[mperrah]

Hard to test without sample data, but try this on a copy of your workbook.

Sub Inventory_edit()
Dim lastrow As Long
Dim wsSP, wsI, wsRM As Worksheet

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

wsSP = Worksheets("Sold Parts")
wsI = Worksheets("Inventory")
wsRM = Worksheets("RunMacros")

lastrow = wsSP.Cells(Rows.Count, 6).End(xlUp).Row

wsI.Cells(7, Rows.Count.End(xlDown)).Delete shift:=xlUp

wsSP.Range("F2:G" & lastrow).Copy Destination:=wsRM.Range("A2")

wsRM.Range("A1:B" & lastrow).RemoveDuplicates Columns:=1, Header:=xlYes


With wsRM.Sort
.SetRange Range("A1:B" & lastrow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

wsRM.Range("A2:B" & Rows.Count.End(xlDown.Row)).Copy wsI.Range("I7")

Range("H7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C17,13),"""")"
Range("K7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,2),"""")"
Range("L7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,8),"""")"
Range("M7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,9),"""")"
Range("O7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,10),"""")"
Range("P7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,11),"""")"
Range("Q7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,12),"""")"
Range("R7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C18,SoldParts!C15),"""")"
Range("S7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C19,SoldParts!C15),"""")"
Range("T7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C20,SoldParts!C15),"""")"
Range("U7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C21,SoldParts!C15),"""")"


Range("Inventory[#Headers]").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("H1").Select

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub

 

[mperrah]

found a few typos, still tough without sample data...

Sub Inventory_edit_v2()
Dim lastrow As Long
Dim wsSP, wsI, wsRM As Worksheet

With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wsSP = Sheets("SoldParts")
Set wsI = Sheets("Inventory")
Set wsRM = Sheets("RunMacros")

lrSP = wsSP.Cells(Rows.Count, 6).End(xlUp).Row

wsI.Range("A7:Q" & Rows.Count).End(xlDown).Delete shift:=xlUp

wsSP.Range("F2:G" & lrSP).Copy Destination:=wsRM.Range("A2")

wsRM.Range("A1:B" & lrSP).RemoveDuplicates Columns:=1, Header:=xlYes


With wsRM.Sort
.SetRange Range("A1:B" & lrSP)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

wsRM.Range("A2:B" & Rows.Count).End(xlDown).Copy wsI.Range("I7")

Range("H7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C17,13),"""")"
Range("K7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,2),"""")"
Range("L7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,8),"""")"
Range("M7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,9),"""")"
Range("O7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,10),"""")"
Range("P7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,11),"""")"
Range("Q7").FormulaR1C1 = "=IFERROR(VLOOKUP(RC9,Stock!C4:C16,12),"""")"
Range("R7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C18,SoldParts!C15),"""")"
Range("S7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C19,SoldParts!C15),"""")"
Range("T7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C20,SoldParts!C15),"""")"
Range("U7").FormulaR1C1 = "=IFERROR(SUMIF(SoldParts!C3,RC9&R6C21,SoldParts!C15),"""")"


wsI.Range("Headers").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("H1").Select

With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With

End Sub