assistance to modify existing vba code index ,match due to change of sheet format

[RAM72]

I have a workbook with imput datasheet and Product database .

Using index and match vba code as below.


however due to change in format , the columns have move in both sheets imput and product database .

Looking assistance for help to change the code according the columns No
in the amended sheet column file.

I have attached the original one testxlsm and the amended xlsm which is the one in which the columns no have be moved .

Looking assistance for help to change the code according the columns No

in the amended sheet format

The original lookup in the third column reference imput data and extract as per reference data in product database that is column A and Column B of product database.

thanks if someone can assist

Sub M1()


    Dim x      As Long
    Dim arr()  As Variant
    Dim temp    As Variant
    Dim ws1    As Worksheet
    Dim ws2    As Worksheet
    Dim dic    As Object
  
    Const delim As String = "|"
  
    Set ws1 = Sheets("Input Datasheet")
    Set ws2 = Sheets("Product DataBase ")
    Set dic = CreateObject("Scripting.Dictionary")


    Application.ScreenUpdating = False
  
    With ws2
        For x = 1 To .Cells(.Rows.Count, 3).End(xlUp).Row
            dic(Val(.Cells(x, 3).Value)) = .Cells(x, 1).Value & delim & .Cells(x, 2).Value
        Next x
    End With
  
    With ws1
        x = .Cells(.Rows.Count, 3).End(xlUp).Row
        arr = .Cells(2, 1).Resize(x - 1, 4).Value
      
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(.Cells(x + 1, 3).Value) Then
                temp = Split(dic(.Cells(x + 1, 3).Value), delim)
                arr(x, 1) = temp(0)
                arr(x, 2) = temp(1)
                Erase temp
            Else
                arr(x, 1) = Empty
                arr(x, 2) = Empty
            End If
        Next x
      
        .Cells(2, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
    End With
  
    Application.ScreenUpdating = True
  
    Set dic = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
    Erase arr
  
End Sub

 

[RAM72]

ok clear I find out where It was going wrong .
thread close