VBA code solution does not work as required-CodePudding

I want results as I mark yellow in the screenshot below. Maybe there is the best solution because I tried not to succeed. There may be the best recommendation solution. so the code I use doesn't have any results

SHEET : DBMASTER
CODE    DESCRIPTION    PRICE1   UNIT    PRICE2  UNIT2
1000    BAG R 1000 NEW  10000   YARD    15000   MTR
1001    BAG R 1001 NEW  20000   YARD    25000   MTR
1002    BAG R 1002 NEW  25000   YARD    30000   MTR

SHEET : DATADB
INV    CODE  DESCRIPTION    QTY UNIT1   REMARK             PRICE1
01-001  1000                10          READY IN BRANCH 01  
01-002  1002                15          READY IN BRANCH 01  
01-003  1000                25          READY IN BRANCH 02  
01-004  1001                12          READY IN BRANCH 03  
01-005  1000                13          READY IN BRANCH 04

OUTPUT DESIRED RESULT SHEET : DATADB
INV     CODE    DESCRIPTION     QTY UNIT1   REMARK              PRICE1
01-001  1000    BAG R 1000 NEW  10  YARD    READY IN BRANCH 01  15000
01-002  1002    BAG R 1002 NEW  15  YARD    READY IN BRANCH 01  30000
01-003  1000    BAG R 1000 NEW  25  YARD    READY IN BRANCH 02  15000
01-004  1001    BAG R 1001 NEW  12  YARD    READY IN BRANCH 03  25000
01-005  1000    BAG R 1000 NEW  13  YARD    READY IN BRANCH 04  15000

Sub trial()
Dim Rng As Range, Ds As Range, n As Long, Dic As Object, Source As Variant
Dim Ary As Variant
Application.ScreenUpdating = False
With Sheets("DBMASTER")
    Source = .Range("C1").CurrentRegion.Offset(, 0).Resize(, 6)
End With
Set Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbBinaryCompare
For n = 2 To UBound(Source, 1)
    Dic(Source(n, 1)) = n
Next
With Sheets("DATADB")
    Ary = .Range("B2", .Range("B" & Rows.Count).End(xlUp)).Value2
'update code
    ReDim Nary(1 To UBound(Ary), 1 To 5)
    For n = 1 To UBound(Ary)
         If Dic.Exists(Ary(n, 1)) Then
            Nary(n, 1) = Source(Dic(Ary(n, 1)), 2)
            Nary(n, 3) = Source(Dic(Ary(n, 1)), 4)
            Nary(n, 5) = Source(Dic(Ary(n, 1)), 3)
            End If
    Next n
 .Range("C2").Resize(UBound(Nary), 5).Value = Nary
    Application.ScreenUpdating = True
End With
End Sub

CodePudding user response：

Please, test the next updated code. It will return starting from "I1". If the return is OK(what you need), you may overwrite the initial range (dropping the result in "A1"):

Sub trial()
 Dim n As Long, Dic As Object, Source, Ary

 With Sheets("DBMASTER")
    Source = .Range("C1").CurrentRegion.Offset(, 0).Resize(, 6)
 End With
 Set Dic = CreateObject("scripting.dictionary")
 Dic.CompareMode = vbBinaryCompare
 For n = 2 To UBound(Source, 1) 'place the necessary data in the a dict item array
    Dic(Source(n, 1)) = Array(Source(n, 2), Source(n, 4), Source(n, 5))
 Next

 With Sheets("DATADB")
    Ary = .Range("A1:G" & .Range("B" & rows.count).End(xlUp).Row).Value2
    For n = 2 To UBound(Ary)
        If Dic.Exists(Ary(n, 2)) Then
            Ary(n, 3) = Dic(Ary(n, 2))(0)
            Ary(n, 5) = Dic(Ary(n, 2))(1)
            Ary(n, 7) = Dic(Ary(n, 2))(2)
        End If
    Next n
    .Range("I1").Resize(UBound(Ary), UBound(Ary, 2)).value2 = Ary
 End With
End Sub

CodePudding user response：

Replace CStr(Ary(n, 1)) with Ary(n, 1)

The items in your dictionary are of type Double (see image below):

But you check for existance of a String when you use Dic.Exists(CStr(Ary(n, 1))). Therefore you need to remove CStr.

I doubt that VBA is faster than a VLOOKUP formula in the cell. Note that VBA cannot use multi-threading and therefore can only use one thread/core of your processor. Fomulas in cells do not have this limitation, and therefore are usually faster. I recommed to test it with a huge bunch of data which one really is faster.