Problem in vba vlookup

[roykana]

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

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

 

[roykana]

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

Dear Mr. Zot,


I'm sure you can help me to modify the vba vlookup that I mean. If you are willing then I will post the vba code.

Thanks
Roykana

 

[roykana]

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

Dear Mr. Zot


I'm sure you can help me to modify the vba vlookup that I mean. If you are willing then I will post the vba code.


Thanks

Roykana

 

[roykana]

Dear Mr. Zot


I'm sure you can help me to modify the vba vlookup that I mean. If you are willing then I will post the vba code.


Thanks

Roykana

Mr. Zot,

This is the code I mean, I think it's a fast vlookup, you can help to modify it


Thanks
Roykana

Sub TestVBA()
    OptimizeVBA True
    Dim startTime As Single, endTime As Single
    startTime = Timer
    
    Dim sWb As Workbook
    Dim fWs As Worksheet, sWs As Worksheet
    Dim slRow As Long, flRow As Long
    Dim pSKU As Range, luVal As Range
    Dim lupSKU As Range, outputCol As Range
    Dim vlookupCol As Object
    
    Set sWb = Workbooks.Open(ThisWorkbook.Path & "\work.xlsx")
    Set sWs = sWb.Sheets("dbkana")
    Set fWs = ThisWorkbook.Sheets("kana")
    
    slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row
    flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row
    
    Set pSKU = sWs.Range("D2:D" & slRow)
    Set lupSKU = fWs.Range("D2:D" & flRow)
    
    For i = 17 To 24
        Set outputCol = fWs.Range(fWs.Cells(2, i), fWs.Cells(flRow, i))
        Select Case i
            Case 17
                Set luVal = sWs.Range("H2:H" & slRow)
            Case 18
                Set luVal = sWs.Range("K2:K" & slRow)
            Case 19
                Set luVal = sWs.Range("L2:L" & slRow)
            Case 20
                Set luVal = sWs.Range("M2:M" & slRow)
            Case 21
                Set luVal = sWs.Range("N2:N" & slRow)
            Case 22
                Set luVal = sWs.Range("P2:P" & slRow)
            Case 23
                Set luVal = sWs.Range("Q2:Q" & slRow)
            Case 24
                Set luVal = sWs.Range("R2:R" & slRow)
        End Select
    
    'Build Collection
        Set vlookupCol = BuildLookupCollection(pSKU, luVal)
    
    'Lookup the values
        VLookupValues lupSKU, outputCol, vlookupCol
    Next i
    
    endTime = Timer
    Debug.Print (endTime - startTime) & " seconds have passed [VBA]"
    OptimizeVBA False
    sWb.Close False
    Set vlookupCol = Nothing
End Sub
 
Function BuildLookupCollection(categories As Range, values As Range)
    Dim vlookupCol As Object, i As Long
    Set vlookupCol = CreateObject("Scripting.Dictionary")
    For i = 1 To categories.Rows.Count
        vlookupCol.Item(CStr(categories(i))) = values(i)
    Next i
    
    Set BuildLookupCollection = vlookupCol
End Function
 
Sub VLookupValues(lookupCategory As Range, lookupValues As Range, vlookupCol As Object)
    Dim i As Long, resArr() As Variant
    ReDim resArr(lookupCategory.Rows.Count, 1)
    For i = 1 To lookupCategory.Rows.Count
        resArr(i - 1, 0) = vlookupCol.Item(CStr(lookupCategory(i)))
    Next i
    lookupValues = resArr
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]

Looks like this create smaller table to lookup?

Probably later to look at it. Time close work

 

[Akuini]

@roykana

3. I want vba code which is automatic like "Worksheet Change" or if any other code

Do you mean if you enter new data in col A then it will run the macro?
But if this is what you want then you need a code to fill data only in that new row, not all rows.
The code to fill all rows just need to run once, so I think 2-3 minutes process is acceptable.

 

[roykana]

@roykana

Do you mean if you enter new data in col A then it will run the macro?
But if this is what you want then you need a code to fill data only in that new row, not all rows.
The code to fill all rows just need to run once, so I think 2-3 minutes process is acceptable.

Dear Mr .akuini,

if point 3 makes the process longer then I will remove it for point 3.

Thanks
Roykana

 

[roykana]

Dear Mr .akuini,

if point 3 makes the process longer then I will remove it for point 3.

Thanks
Roykana

how can you modify it from the code I provide

 

[roykana]

Looks like this create smaller table to lookup?

Probably later to look at it. Time close work

how can you modify it from the code I provide

 

[roykana]

Dear all master,

can anyone help and provide a solution for the vba code?

thank you
Roykana

 

[Akuini]

if point 3 makes the process longer then I will remove it for point 3.

I don't understand your words.
Do you mean you don't need the automatic code?

As for your code in post #13, to fill all rows.
Does it work?
How long did it take?
How long is the acceptable processing time?
But I don't understand why 2-3 minutes processing time isn't acceptable for you. You only need to run it once.