Problem in vba vlookup

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
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
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
Office Version
  1. 2010
Platform
  1. Windows
Dear all master,
can anyone help me for the vba code?

Thanks
Roykana
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
Office Version
  1. 2010
Platform
  1. Windows
Dear all master,
can anyone help me for the vba code?

Thanks
Roykana
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
602
Office Version
  1. 2016
Platform
  1. Windows
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
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
602
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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 😄
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
Office Version
  1. 2010
Platform
  1. Windows
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
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: 55

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
602
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

How fast is yours?
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
Office Version
  1. 2010
Platform
  1. Windows
How fast is yours?
Dear Mr. Zot,


I attach the time results from the code I posted above


Thanks
Roykana
 

Attachments

  • RESULT MY CODE.PNG
    RESULT MY CODE.PNG
    2.4 KB · Views: 58

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
602
Office Version
  1. 2016
Platform
  1. Windows
Dear Mr. Zot,


I attach the time results from the code I posted above


Thanks
Roykana
I see. When I first run without Statusbar, it took about 220 something I guess. Not much faster.
 

roykana

Board Regular
Joined
Mar 8, 2018
Messages
113
Office Version
  1. 2010
Platform
  1. Windows
I see. When I first run without Statusbar, it took about 220 something I guess. Not much faster.
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: 53

Watch MrExcel Video

Forum statistics

Threads
1,123,281
Messages
5,600,704
Members
414,401
Latest member
grenona2020

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
Top