Problem in vba vlookup

R

roykana

Active Member
Joined
Mar 8, 2018
Messages
311
Office Version
  1. 2010
Platform
  1. Windows
Dear All Master,

The problem I mean is as follows :

1. I want to modify the vba code because it takes too long/very slow to vlookup in VBA code so I want a very fast vba code
2. I want to set from column I2 and J2 in the sheet "GSD" and I mark it in yellow
3. I want vba code which is automatic like "Worksheet Change" or if any other code
this is my link : SALES ALL IN ONE 2016-NOW-vba - Copy.xlsm
file
VBA Code: 
Option Explicit
Sub multivlookupV2()
 OptimizeVBA True
 Dim startTime As Single, endTime As Single
    startTime = Timer
 With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    ActiveSheet.DisplayPageBreaks = False
 With Range(Cells(2, 9), Cells(2, 9).End(xlDown))
       .FormulaR1C1 = "=IF([@ITM]=""JASA SERVICE"",""NO"",IF([@DEPT]=""BOJ"",VLOOKUP([@ITM],MASTER_ITEM_NO,4,0),IF([@DEPT]=""M18"",VLOOKUP([@ITM],MASTER_ITEM_NO[[M18]:[ITEM NO NEW]],3,0),IF([@DEPT]=""MD2"",VLOOKUP([@ITM],MASTER_ITEM_NO[[MD2]:[ITEM NO NEW]],2,0),IF([@DEPT]=""M07"",VLOOKUP([@ITM],MASTER_ITEM_NO[[M18]:[ITEM NO NEW]],3,0))))))"
       .Value = .Value
 End With
  With Range(Cells(2, 10), Cells(2, 10).End(xlDown))
       .FormulaR1C1 = "=VLOOKUP([@PNM],GSG,9,0)"
       .Value = .Value
 End With
 With Application
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
 End Sub
 Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub
Thanks
Roykana
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
Dear all master,
can anyone help me for the vba code?

Thanks
Roykana
 
Upvote 0
Dear all master,
can anyone help me for the vba code?

Thanks
Roykana
 
Upvote 0
Instead of using VBA to write formula into worksheet and and then sheet to calculate, why not just let VBA do the VLookUp and fill the table.

You already have line to call OptimizeVBA routine but then you still have these
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

meaning you execute those twice.

I saw corrupted range name in your sheet and I cannot remove it. There are range by name Table1 that cause error when I ran. So, renamed it to avoid clash with my code.

I'm not sure what Excel version you have since you did not fill in your profile completely. I have 2016. It tool me around 255s to complete but then I added Statusbar and DoEvent so that I can see progress. Without DoEvents the Excel may froze. However, adding Statusbar will add some toll to run time probably a minute or two but at least I can see progress.

VBA Code: 
Option Explicit
    
Sub LookUpv3()

Dim eRowGSD&, eRowGSG&, n&
Dim cell As Range, Table1 As Range, Table2 As Range, Table3 As Range, Table4 As Range
Dim wb As Workbook
Dim wsGSD As Worksheet, wsMIN As Worksheet, wsGSG As Worksheet
Dim startTime As Single, endTime As Single

OptimizeVBA True
 
Set wb = ActiveWorkbook
Set wsGSD = wb.Sheets("GSD")
Set wsMIN = wb.Sheets("MASTER_ITEM_NO")
Set wsGSG = wb.Sheets("GSG")

Set Table1 = wsMIN.Range("A2", "D31095")
wb.Names.Add Name:="Table1", RefersTo:=Table1

Set Table2 = wsMIN.Range("B2", "D31095")
wb.Names.Add Name:="Table2", RefersTo:=Table2

Set Table3 = wsMIN.Range("C2", "D31095")
wb.Names.Add Name:="Table3", RefersTo:=Table3

Set Table4 = wsGSG.Range("A2", "I22443")
wb.Names.Add Name:="Table4", RefersTo:=Table4
 
eRowGSD = wsGSD.Range("G" & wsGSD.Cells.Rows.Count).End(xlUp).Row
eRowGSG = wsGSG.Range("G" & wsGSG.Cells.Rows.Count).End(xlUp).Row

startTime = Timer

n = 0
With wsGSD
    For Each cell In .Range("G2", "G" & eRowGSD)
        DoEvents
        n = n + 1
        Application.StatusBar = "Status = Line " & n & " of " & (eRowGSD - 2) & " lines. Percent " & Format(n / (eRowGSD - 2), "Percent")
        Select Case cell
            Case "BOJ"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table1, 4, 0)
            Case "M18", "M07"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table2, 3, 0)
            Case "MD2"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table3, 2, 0)
        End Select
        .Range("J" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("A" & cell.Row), Table4, 9, 0)
    Next
 End With
 
endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False

End Sub

 Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub
 
Upvote 0
I forgot to mention that I bet if I run the same code on ancient Excel 2003, the completion time probably cut by more than half ?
 
Upvote 0
Zot said:
Instead of using VBA to write formula into worksheet and and then sheet to calculate, why not just let VBA do the VLookUp and fill the table.

You already have line to call OptimizeVBA routine but then you still have these
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
.EnableEvents = False
End With

meaning you execute those twice.

I saw corrupted range name in your sheet and I cannot remove it. There are range by name Table1 that cause error when I ran. So, renamed it to avoid clash with my code.

I'm not sure what Excel version you have since you did not fill in your profile completely. I have 2016. It tool me around 255s to complete but then I added Statusbar and DoEvent so that I can see progress. Without DoEvents the Excel may froze. However, adding Statusbar will add some toll to run time probably a minute or two but at least I can see progress.

VBA Code: 
Option Explicit
   
Sub LookUpv3()

Dim eRowGSD&, eRowGSG&, n&
Dim cell As Range, Table1 As Range, Table2 As Range, Table3 As Range, Table4 As Range
Dim wb As Workbook
Dim wsGSD As Worksheet, wsMIN As Worksheet, wsGSG As Worksheet
Dim startTime As Single, endTime As Single

OptimizeVBA True

Set wb = ActiveWorkbook
Set wsGSD = wb.Sheets("GSD")
Set wsMIN = wb.Sheets("MASTER_ITEM_NO")
Set wsGSG = wb.Sheets("GSG")

Set Table1 = wsMIN.Range("A2", "D31095")
wb.Names.Add Name:="Table1", RefersTo:=Table1

Set Table2 = wsMIN.Range("B2", "D31095")
wb.Names.Add Name:="Table2", RefersTo:=Table2

Set Table3 = wsMIN.Range("C2", "D31095")
wb.Names.Add Name:="Table3", RefersTo:=Table3

Set Table4 = wsGSG.Range("A2", "I22443")
wb.Names.Add Name:="Table4", RefersTo:=Table4

eRowGSD = wsGSD.Range("G" & wsGSD.Cells.Rows.Count).End(xlUp).Row
eRowGSG = wsGSG.Range("G" & wsGSG.Cells.Rows.Count).End(xlUp).Row

startTime = Timer

n = 0
With wsGSD
    For Each cell In .Range("G2", "G" & eRowGSD)
        DoEvents
        n = n + 1
        Application.StatusBar = "Status = Line " & n & " of " & (eRowGSD - 2) & " lines. Percent " & Format(n / (eRowGSD - 2), "Percent")
        Select Case cell
            Case "BOJ"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table1, 4, 0)
            Case "M18", "M07"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table2, 3, 0)
            Case "MD2"
                .Range("I" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("B" & cell.Row), Table3, 2, 0)
        End Select
        .Range("J" & cell.Row) = Application.WorksheetFunction.VLookup(.Range("A" & cell.Row), Table4, 9, 0)
    Next
End With

endTime = Timer
Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
OptimizeVBA False

End Sub

Sub OptimizeVBA(isOn As Boolean)
    Application.Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)
    Application.EnableEvents = Not (isOn)
    Application.ScreenUpdating = Not (isOn)
    ActiveSheet.DisplayPageBreaks = Not (isOn)
End Sub
Click to expand...
Dear Mr. Zot,

Thank you for your reply.

slower than the vba code I post.

I am using excel 2010

Thanks

Roykana
 

Attachments

  • RESULT.PNG
    RESULT.PNG
    3 KB · Views: 63
Upvote 0
roykana said:
Dear Mr. Zot,


I attach the time results from the code I posted above


Thanks
Roykana
Click to expand...
I see. When I first run without Statusbar, it took about 220 something I guess. Not much faster.
 
Upvote 0
Zot said:
I see. When I first run without Statusbar, it took about 220 something I guess. Not much faster.
Click to expand...
Dear Mr. Zot,

I have a solution. I have a code vba I think this is a fast vlookup code vba but it needs to be modified.

Thanks

Roykana
 

Attachments

  • RESULT without status bar.PNG
    RESULT without status bar.PNG
    2.6 KB · Views: 60
Upvote 0
You must log in or register to reply here.

Similar threads

Guna13
  • Question
How to Efficient way for create Multiple Workbooks
Replies
1
Views
78
Guna13
Guna13
E
  • Question
Trying to use a month name in my VLookup
Replies
2
Views
136
Eric Penfold
E
R
  • Solved
Import multi dat files in vba run-time error 13
2 3
Replies
25
Views
1K
Marc L
Marc L
D
  • Question
Vlookup VBA returning Blank Values
Replies
2
Views
811
Fluff
Fluff
D
  • Locked
  • Question
VBA Vlookup Code only returning first 62 values
Replies
3
Views
328
Fluff
Fluff

Forum statistics

Threads
1,214,391
Messages
6,119,239
Members
448,879
Latest member
VanGirl

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