Speedup vlookup in macro

[yaboseyo]

Hi all,


I saw another thread on the same topic but I am not able to reuse the information provided before.

I am trying to reduce the size of my file and to speedup my macro which contain a huge dirty Vlookup

I know its an ugly macro but cant get my head around, need some helps

Thanks in advance

Here the Macro:

Sheets("MasterData").Select
Range("AH9").Select
Range(Selection, Range("AH65536").End(xlUp)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CalcData").Select
Range("L9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MasterData").Select
Range("AI9").Select
Range(Selection, Range("AI65536").End(xlUp)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CalcData").Select
Range("N9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("MasterData").Select
Range("AJ9").Select
Range(Selection, Range("AJ65536").End(xlUp)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("CalcData").Select
Range("O9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


' Apply formulas

Sheets("CalcData").Select
Range("C9").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-2],InventoryReport!C[-1]:C[1],3,0),0)"
Range("C9").Select
Selection.AutoFill Destination:=Range("C9:C" & Range("A9").End(xlDown).Row)
Range("C9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("C9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("CalcData").Select
Range("D9").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(C[-3],InventoryReport!C[-2]:C[2],5,0),0)"
Range("D9").Select
Selection.AutoFill Destination:=Range("D9:D" & Range("A9").End(xlDown).Row)
Range("D9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("D9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("S9").Select
ActiveCell.FormulaR1C1 = _
"=+IFERROR(VLOOKUP(C1,MouvementReport!C1:C107,CalcData!R7C[3],0),0)"
Range("S9").Select
Selection.AutoFill Destination:=Range("S9:BR9"), Type:=xlFillDefault
Range("S9:BR9").Select
Selection.AutoFill Destination:=Range("S9:BR" & Range("A9").End(xlDown).Row)
Range("S9:BR9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("S9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Range("BT9").Select
ActiveCell.FormulaR1C1 = "=+IFERROR(VLOOKUP(C71,Code!R1C1:R5C2,2,0),0)"
Range("BT9").Select
Selection.AutoFill Destination:=Range("BT9:BT" & Range("A9").End(xlDown).Row)
Range("BT9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("BT9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False


Range("BW9").Select
ActiveCell.FormulaR1C1 = _
"=+IFERROR(STDEVP(RC[-56]:RC[-5])/AVERAGE(RC[-56]:RC[-5]),0)"
Range("BX9").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=0,""Z"",IF(RC[-1]<=1,""L"",IF(RC[-1]>3,""H"",""M"")))"
Range("BY9").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]=""Z"",""DZ"",CONCATENATE(RC[-67],RC[-1]))"
Range("BZ9").Select
ActiveCell.FormulaR1C1 = _
"=+IF(RC[-1]=""DZ"","""",VLOOKUP(RC[-1],Code!R9C1:R17C2,2,0))"
Range("CA9").Select
ActiveCell.FormulaR1C1 = _
"=+IF(RC[-2]=""DZ"","""",VLOOKUP(RC[-2],Code!R9C1:R17C3,3,0))"
Range("CB9").Select
ActiveCell.FormulaR1C1 = _
"=+IFERROR(STDEVP(RC[-61]:RC[-10])*NORMSINV(RC[-2])*SQRT((RC[-67]/7)),0)"
Range("CC9").Select
ActiveCell.FormulaR1C1 = "=+IFERROR(RC[-1]*365/SUM(RC[-62]:RC[-11]),0)"

Range("BW9:CC9").Select
Selection.AutoFill Destination:=Range("BW9:CC" & Range("A9").End(xlDown).Row)
Range("BW9:CC9").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Range("BW9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 

[Weaver]

You could replace the bit before the 'apply formulas' comment. Hopefully this will give you some ideas as to how to deal with the rest.

Sub copyPasteTest()
    Application.ScreenUpdating = False
    With Sheets("masterData")
        For i = 0 To 2
            c = Range("AH1").Column + i
            .Range(.Cells(9, c), .Cells(Rows.Count, c).End(xlUp)).Copy
            Sheets("CalcData").Cells(9, i + 12).PasteSpecial Paste:=xlValues
        Next i
    End With
End Sub

but I think it's always going to take some time to work as there are a lot of formulas involved. Generally though, as the above shows, copying & pasting direct to cells, rather than selecting and then populating is usually quicker. You can also save time by not updating the screen after every action (Application.ScreenUpdating = False)

HTH

 

[GlennUK]

Some of your VLOOKUP formulas are referencing entire columns ... alter these to access only the relevant rows.

 

[p45cal]

Weaver, careful; although the source columns are adjacent, the destination columns are not.

I'm with Glenn, many of your vlookups are referring to entire columns, both for what they're looking up and where they're looking for it.

Try the following. Note that there are 4 instances of commented out statements:
.Value = .Value
and one:
.Range("BW9:CC9").Value = .Range("BW9:CC9").Value

which will convert formula results to values. You should un-comment them once you've checked the formulae give the results you expect.

Sub blah()
With Sheets("MasterData")
  .Range(.Range("AH9"), .Range("AH65536").End(xlUp)).Copy
  Sheets("CalcData").Range("L9").PasteSpecial Paste:=xlPasteValues
  
  .Range(.Range("AI9"), .Range("AI65536").End(xlUp)).Copy
  Sheets("CalcData").Range("N9").PasteSpecial Paste:=xlPasteValues

  .Range(.Range("AJ9"), .Range("AJ65536").End(xlUp)).Copy
  Sheets("CalcData").Range("O9").PasteSpecial Paste:=xlPasteValues
End With

InvRepLR = Sheets("InventoryReport").Cells.SpecialCells(xlCellTypeLastCell).Row
MouvRepLR = Sheets("MouvementReport").Cells.SpecialCells(xlCellTypeLastCell).Row
' Apply formulas
With Sheets("CalcData")
  LR = .Range("A9").End(xlDown).Row
  With .Range("C9:C" & LR)
    .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,InventoryReport!R1C2:R" & InvRepLR & "C4,3,0),0)"
    '.Value = .Value
  End With
  With .Range("D9:D" & LR)
    .FormulaR1C1 = "=IFERROR(VLOOKUP(RC1,InventoryReport!R1C2:R" & InvRepLR & "C6,5,0),0)"
    '.Value = .Value
  End With
  With .Range("S9:BR" & LR)
    .FormulaR1C1 = "=+IFERROR(VLOOKUP(RC1,MouvementReport!R1C1:R" & MouvRepLR & "C107,R7C[3],0),0)"
    '.Value = .Value
  End With
  With .Range("BT9:BT" & LR)
    .FormulaR1C1 = "=+IFERROR(VLOOKUP(RC71,Code!R1C1:R5C2,2,0),0)"
    ' .Value = .Value
  End With

  .Range("BW9:BW" & LR).FormulaR1C1 = "=+IFERROR(STDEVP(RC[-56]:RC[-5])/AVERAGE(RC[-56]:RC[-5]),0)"
  .Range("BX9:BX" & LR).FormulaR1C1 = "=IF(RC[-1]=0,""Z"",IF(RC[-1]<=1,""L"",IF(RC[-1]>3,""H"",""M"")))"
  .Range("BY9:BY" & LR).FormulaR1C1 = "=IF(RC[-1]=""Z"",""DZ"",CONCATENATE(RC[-67],RC[-1]))"
  .Range("BZ9:BZ" & LR).FormulaR1C1 = "=+IF(RC[-1]=""DZ"","""",VLOOKUP(RC[-1],Code!R9C1:R17C2,2,0))"
  .Range("CA9:CA" & LR).FormulaR1C1 = "=+IF(RC[-2]=""DZ"","""",VLOOKUP(RC[-2],Code!R9C1:R17C3,3,0))"
  .Range("CB9:CB" & LR).FormulaR1C1 = "=+IFERROR(STDEVP(RC[-61]:RC[-10])*NORMSINV(RC[-2])*SQRT((RC[-67]/7)),0)"
  .Range("CC9:CC" & LR).FormulaR1C1 = "=+IFERROR(RC[-1]*365/SUM(RC[-62]:RC[-11]),0)"

  '.Range("BW9:CC9").Value = .Range("BW9:CC9").Value
End With
End Sub

 

[yaboseyo]

Hi guys,

Thanks all of you for your quick replies!!

I have tried "p45cal" code which works fine but still takes 5 minutes to run (I timed it!!)

I am working with 20,000 rows, so it looks like we can't do faster.

I will keep p45cal code unless someone has a better idea!!

Thanks again!

 

[p45cal]

If you could post the file on the interweb somewhere (box.net?) - with lots of data in it - I'll have a go at speeding it up. If it's too sensitive/private, you could Private Message me here for an address to send it to, or of course search and replace the data with less sensitive/false data before sending it/posting it on the internet.

 

[justme1122]

is it just me or are you missing:

Application.ScreenUpdating = False

Application.ScreenUpdating = True

 

[p45cal]

If you could post the file on the interweb somewhere (box.net?) - with lots of data in it - I'll have a go at speeding it up. If it's too sensitive/private, you could Private Message me here for an address to send it to, or of course search and replace the data with less sensitive/false data before sending it/posting it on the internet.

Having seen the file, I can't speed it up more than it is, but just a few points to note during my playing about:
1. Sure, turn off screenupdating at the start of the macro and back on again at the end.
2. Don't switch Calculation to manual! It took more than three times as long.
3. I had an idea to change the formulae to array-entered to-the-whole-range-at-once ones (.FormulaArray), but this took about twice as long.
4. I slowed it down (only a tiny bit - 1 or 2 seconds) by changing the first bit to allow it to be altered more easily and to remove lots of repeat commands to:

With Sheets("MasterData")
    MDataLR = .UsedRange.Row + .UsedRange.Rows.Count - 1
    CopyRowsCount = MDataLR - 8
    SourceArray = Array("A9", "B9", "E9", "F9", "J9", "K9", "L9", "M9", "N9", "P9", "Q9", "R9", "BS9")
    DestArray = Array("C9", "I9", "O9", "G9", "AF9", "N9", "AH9", "AG9", "AI9", "AJ9", "AD9", "AA9", "E9")
    For i = 0 To UBound(SourceArray)
        Sheets("CalcData").Range(DestArray(i)).Resize(CopyRowsCount).Value = .Range(SourceArray(i)).Resize(CopyRowsCount).Value
    Next i


    '    Sheets("CalcData").Range("A9").Resize(CopyRowsCount).Value = .Range("C9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("B9").Resize(CopyRowsCount).Value = .Range("I9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("E9").Resize(CopyRowsCount).Value = .Range("O9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("F9").Resize(CopyRowsCount).Value = .Range("G9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("J9").Resize(CopyRowsCount).Value = .Range("AF9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("K9").Resize(CopyRowsCount).Value = .Range("N9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("L9").Resize(CopyRowsCount).Value = .Range("AH9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("M9").Resize(CopyRowsCount).Value = .Range("AG9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("N9").Resize(CopyRowsCount).Value = .Range("AI9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("P9").Resize(CopyRowsCount).Value = .Range("AJ9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("Q9").Resize(CopyRowsCount).Value = .Range("AD9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("R9").Resize(CopyRowsCount).Value = .Range("AA9").Resize(CopyRowsCount).Value
    '    Sheets("CalcData").Range("BS9").Resize(CopyRowsCount).Value = .Range("E9").Resize(CopyRowsCount).Value

    '    .Range(.Range("C9"), .Range("C65536").End(xlUp)).Select    'Copy
    '    Sheets("CalcData").Range("A9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("I9"), .Range("I65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("B9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("O9"), .Range("O65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("E9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("G9"), .Range("G65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("F9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AF9"), .Range("AF65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("J9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("N9"), .Range("N65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("K9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AH9"), .Range("AH65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("L9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AG9"), .Range("AG65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("M9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AI9"), .Range("AI65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("N9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AJ9"), .Range("AJ65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("P9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AD9"), .Range("AD65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("Q9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("AA9"), .Range("AA65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("R9").PasteSpecial Paste:=xlPasteValues
    '    .Range(.Range("E9"), .Range("E65536").End(xlUp)).Copy
    '    Sheets("CalcData").Range("BS9").PasteSpecial Paste:=xlPasteValues
End With

remove the commented-out lines, they just show the steps taken.

With regard to point 2 above, it might be worth checking (I haven't) that the technique of converting fomulae entered into their values straight after they've been entered, isn't preventing them changing as later formulae get added to the sheet. That is, make sure that earlier added formulae wouldn't change their results as a result of adding new formulae elsewhere - the order in which formulae are entered could be important.

Whole process down to less than 3 minutes here.