Speedup vlookup in macro

Y

yaboseyo

New Member
Joined
Aug 1, 2011
Messages
2
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:confused:, 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
 

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
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.

Code: 
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
 
Upvote 0
Some of your VLOOKUP formulas are referencing entire columns ... alter these to access only the relevant rows.
 
Upvote 0
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.
Code: 
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
 
Upvote 0
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!
 
Upvote 0
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.
 
Upvote 0
is it just me or are you missing:

PHP: 
Application.ScreenUpdating = False
PHP: 
Application.ScreenUpdating = True
 
Upvote 0
p45cal said:
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.
Click to expand...

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:
Code: 
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA autofilling code
Replies
6
Views
449
Peter_SSs
Peter_SSs
Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
412
Sean15
Sean15
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
K
  • Question Question
Increasing row before the macro runs again
Replies
1
Views
190
kbk
K
willow1985
  • Solved
VBA Run-time error 91 - Object variable or With block variable not set when trying to refresh data/Sleep
Replies
4
Views
245
willow1985
willow1985

Forum statistics

Threads
1,223,268
Messages
6,171,100
Members
452,379
Latest member
IainTru

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