• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

VBA to Fasten Vlookup

This Vlookup I manage to get work, but is very slow on 10000 or so rows

Sub Macro2()
'
' Macro2 Macro
'
' Keyboard Shortcut: Ctrl+y
'
Range("A3").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC8,'[Consolidated Data Sep-14.xlsx]Sheet1'!C1:C8,R1C,FALSE)"
Range("A3").Select
Selection.Copy
Range("B3:G3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A3").Select
End Sub


Googling say Scripting.Dictionary is faster way, but I not used before. Having great trouble finding an example that I can tweak correctly.

Can someone show the way?
Thanks
 
Please post sample data. Formula will update data whenever source data is changed. That may (or may not) occur with macro.
 
VBA solution can be worked out but I was just wondering how the formula approach as attached would fare? The helper cells are marked in yellow. Formula written in cell A3 is simply copied down and across. I'd suppose this will be faster than the VLOOKUP situation you are dealing with.

Test this and if it doesn't help then we'll surely take a shot at VBA.
 

Attachments

  • Macro Book.xlsm
    17.6 KB · Views: 11
Thank you for your reply.

Dear i have sheet 2 in which almost 300,000 rows, from which i have to find 10,000 or more data with vlookup against ConsumerNo.

Please check it thanks.

Solution you provided is on one click but it is not providing correct result.

I am uploading file again, which is not in order
 

Attachments

  • Macro Book (1).xlsm
    19.5 KB · Views: 6
OK. Test this code (Make sure you read comments in the code)
Code:
Public Sub UpdateSheet()
Dim i As Long
Dim rngFnd As Range
Dim wkSrc As Worksheet, wkDst As Worksheet
Set wkSrc = Sheets("Sheet2") '// Change these sheet names to suit
Set wkDst = Sheets("Sheet1")
'\\ Speed up the copy paste process
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With
'\\ Loop through all cells
For i = 3 To wkDst.Cells(Rows.Count, "H").End(xlUp).Row
  Set rngFnd = wkSrc.Cells(1, "A").EntireColumn.Find(wkDst.Cells(i, "H").Value)
  If Not rngFnd Is Nothing Then
  wkSrc.Cells(rngFnd.Row, "B").Resize(1, 7).Copy wkDst.Cells(i, "A")
  End If
Next i
'\\ Reset defaults
With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
End With
End Sub
 
Thank you for reply.

I have changed location of sheet and it given Debug Error (Run Time Error 9, Subscript out of Range).

Coulu you plase check, on here debug error shown

Set wkSrc = Sheets("[Consolidated Data Sep-14.xlsx]Sheet1") '// Change these
 
Looks like you are trying to fetch it from different workbook! It is better to state requirement at the beginning as clearly as possible.

Keep the both workbooks open and modify the posted line as below and test:
Code:
Set wkSrc = Workbooks("Consolidated Data Sep-14.xlsx").Sheets("Sheet1")
 
Thank you for your reply. It works but the issue is it only pick up one record, while not going down and paste in all required cells. It is working in only one row. Not all rows. Please check.

Below is code

Code:
Public Sub UpdateSheet()
Dim i As Long
Dim rngFnd As Range
Dim wkSrc As Worksheet, wkDst As Worksheet
Set wkSrc = Workbooks("Consolidated Data Sep-14.xlsx").Sheets("Sheet1") '// Change these sheet names to suit
Set wkDst = Sheets("Sheet1")
'\\ Speed up the copy paste process
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
End With
'\\ Loop through all cells
For i = 3 To wkDst.Cells(Rows.Count, "H").End(xlUp).Row
  Set rngFnd = wkSrc.Cells(1, "A").EntireColumn.Find(wkDst.Cells(i, "H").Value)
  If Not rngFnd Is Nothing Then
  wkSrc.Cells(rngFnd.Row, "B").Resize(1, 7).Copy wkDst.Cells(i, "A")
  End If
Next i
'\\ Reset defaults
With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
End With
End Sub
 
Thank you very much for reply again.

Actually i was looking for fast working solution. When i used this code for 10,000 rows and 7 columns, it got slow more than normal vlookup.

I have read solution with dictionary in VBA, that's what i am looking here to get all record in seconds
 
While it is true that Dictionary is faster (good for finding uniques), it doesn't directly apply to your situation.

Generally, in memory processing gives faster result. Following is one example. Test it. When I tested with old data the first code took 0.1875 sec whereas this routine took 0.015625 sec so it should give considerably improved results at your end.
Code:
Public Sub UpdateSheet2()
Dim i As Long
Dim rngFnd As Range
Dim wkSrc As Worksheet, wkDst As Worksheet
Dim vaSrc As Variant, vaTst As Variant

Set wkDst = Sheets("Sheet1")
Set wkSrc = Workbooks("Consolidated Data Sep-14.xlsx").Sheets("Sheet1") '// Change these sheet names to suit
vaSrc = wkSrc.Range("A1:H" & wkSrc.Range("A" & Rows.Count).End(xlUp).Row).Value
vaTst = wkDst.Range("A3:H" & wkDst.Range("H" & Rows.Count).End(xlUp).Row).Value

For i = LBound(vaTst) To UBound(vaTst)
  For j = LBound(vaSrc) To UBound(vaSrc)
  If vaTst(i, 8) = vaSrc(j, 1) Then
  vaTst(i, 1) = vaSrc(j, 2)
  vaTst(i, 2) = vaSrc(j, 3)
  vaTst(i, 3) = vaSrc(j, 4)
  vaTst(i, 4) = vaSrc(j, 5)
  vaTst(i, 5) = vaSrc(j, 6)
  vaTst(i, 6) = vaSrc(j, 7)
  vaTst(i, 7) = vaSrc(j, 8)
  Exit For
  End If
  Next j
Next i

wkDst.Range("A3:H" & wkDst.Range("H" & Rows.Count).End(xlUp).Row).Value = vaTst

End Sub
 
thank you for your assistance and taking so much time to resolve the query. After putting the code i get the result, but i must say, vlookup formula work better.

I guess i should compromise on vlookup.

Best Wishes
Shakeel
 
Back
Top