Convert Index and match formula sheet to vba macro

[RAM1972]

Hi All
I made a recorded macro, so if any one can help to put the recorded macro in an elegant vba way some modifcations to be made still to end of last row for both imput sheet column A and B as COLUMN C and D may have data of 1500 to 3500 rows to fill columns A and B of imput sheet.

For Product database same lookup from A,B,C.D to last row. (product database can read up to 30000 rows)
recorded macro has been for short range.as below

Formula not to appear in cells.

As below sample of sheet + formula

and recorded macro

Imput sheet

Coding Reference	Coding Description	Product Code	Product Description
=IFERROR(INDEX('Product Database '!$A:$D,MATCH('Imput Datasheet'!C2,'Product Database '!C:C,0),1),"")	=IFERROR(INDEX('Product Database '!$A:$D,MATCH('Imput Datasheet'!C2,'Product Database '!C:C,0),2),"")	0062531	BAC 30L NOIR

<colgroup><col span="2"><col><col></colgroup><tbody>
</tbody>

Product database

Coding Reference	Coding Description	Product Code	Product Description
83119000	WELDING ELECTRODES	0046371	POUR ASSEMBLAGE TRAVAUX COURANTS (ZINGUERIE, FERBLANTERIE) -

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

Sub INDEXMATCHIFERROETEST()
'
' INDEXMATCHIFERROETEST Macro
'

'
Range("A2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('Product Database '!C1:C4,MATCH('Imput Datasheet'!RC[2],'Product Database '!C[2],0),1),"""")"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:B2"), Type:=xlFillDefault ***(this need to modify to last row of data)***
Range("A2:B2").Select
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('Product Database '!C1:C4,MATCH('Imput Datasheet'!RC[1],'Product Database '!C[2],0),2),"""")"
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B32")
Range("A2:B32").Select
Columns("A:A").ColumnWidth = 19.29
Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(INDEX('Product Database '!C1:C4,MATCH('Imput Datasheet'!RC[1],'Product Database '!C[1],0),2),"""")"
Range("A2:B2").Select
Selection.AutoFill Destination:=Range("A2:B32")
Range("A2:B32").Select
Columns("B:B").EntireColumn.AutoFit
Selection.AutoFill Destination:=Range("A2:B35"), Type:=xlFillDefault***(this need to modify to last row of data)***
Range("A2:B35").Select
End Sub

 

[RAM1972]

I rechecked with a cool mind, I was too much overloaded last week.

Now it ok.

Thank for valuable assistance

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

<colgroup><col></colgroup><tbody>
</tbody>

 

[JackDanIce]

Glad it's working and resolved.