I need VBA code

[roykana]

The VBA code that I want is as follows:
1. I want a "vlookup" VBA code to be typed so that the desired results appear.
2. I want a "sumif" VBA code.

I want the fastest vlookup and sumif vba code and the simplest code that makes it easy for me to understand. The reason I want to use Vba code is because the original data is thousands of lines and uses vlookup and sumif formulas, so the processor calculation becomes slower and I have to wait. I Attach 2 excel files namely the ACCEPTANCE MATERIALS ITEM & DELIVERY MATERIAL first - 2018 test and second FORMULA INFORMATION.
This is my file link google drive : https://drive.google.com/file/d/1LKD...ew?usp=sharing
Thanks

roykana

[SamT]

Referring to Rows 2, 3, & 4 on Information Formula.xlsx
Please provide examples of the actual VLookup formulas you are currently using for those three situations

I approve of the layouts of your data tables, however, I recommend that the Item Description be the first (Key) column of all tables, because it is the only Field common to all tables

[roykana]

Dear Mr. SamT,



Thank you for your response, For lines 2,3,4 the key refers to "CODE BAHAN".
I want to ask if you use VBA code then the result is value or not ?.
With this I attach the excel file information formula that I have updated.


Thanks
Roykana

[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 & "\sample.xlsx")
Set sWs = sWb.Sheets("Sheet1")
Set fWs = ThisWorkbook.Sheets("Sheet1")

slRow = sWs.Cells(Rows.Count, 4).End(xlUp).Row
flRow = fWs.Cells(Rows.Count, 4).End(xlUp).Row

Set pSKU = sWs.Range("D2" & slRow)
Set lupSKU = fWs.Range("D2" & 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

[roykana]

Dear sir
please modify the vba code above so i can use it.

Thanks
Roykana

[roykana]

I got the VBA code from Google

I got the VBA code from Google