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
[TABLE="width: 1648"]
<colgroup><col span="2"><col><col></colgroup><tbody>[TR]
[TD]Coding Reference
[/TD]
[TD]Coding Description[/TD]
[TD]Product Code [/TD]
[TD]Product Description[/TD]
[/TR]
[TR]
[TD] =IFERROR(INDEX('Product Database '!$A:$D,MATCH('Imput Datasheet'!C2,'Product Database '!C:C,0),1),"")[/TD]
[TD] =IFERROR(INDEX('Product Database '!$A:$D,MATCH('Imput Datasheet'!C2,'Product Database '!C:C,0),2),"")[/TD]
[TD]0062531[/TD]
[TD]BAC 30L NOIR[/TD]
[/TR]
</tbody>[/TABLE]

Product database
[TABLE="width: 775"]
<colgroup><col><col><col><col></colgroup><tbody>[TR]
[TD]Coding Reference
[/TD]
[TD]Coding Description[/TD]
[TD]Product Code [/TD]
[TD]Product Description[/TD]
[/TR]
[TR]
[TD]83119000[/TD]
[TD]WELDING ELECTRODES[/TD]
[TD]0046371[/TD]
[TD]POUR ASSEMBLAGE TRAVAUX COURANTS (ZINGUERIE, FERBLANTERIE) -[/TD]
[/TR]
</tbody>[/TABLE]

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

[TABLE="width: 514"]
<colgroup><col></colgroup><tbody>[TR]
[TD]Sub M1()[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD] Dim x As Long[/TD]
[/TR]
[TR]
[TD] Dim arr() As Variant[/TD]
[/TR]
[TR]
[TD] Dim temp As Variant[/TD]
[/TR]
[TR]
[TD] Dim ws1 As Worksheet[/TD]
[/TR]
[TR]
[TD] Dim ws2 As Worksheet[/TD]
[/TR]
[TR]
[TD] Dim dic As Object[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] Const delim As String = "|"[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] Set ws1 = Sheets("Input Datasheet")[/TD]
[/TR]
[TR]
[TD] Set ws2 = Sheets("Product DataBase ")[/TD]
[/TR]
[TR]
[TD] Set dic = CreateObject("Scripting.Dictionary")[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD] Application.ScreenUpdating = False[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] With ws2[/TD]
[/TR]
[TR]
[TD] For x = 1 To .Cells(.Rows.Count, 3).End(xlUp).Row[/TD]
[/TR]
[TR]
[TD] dic(Val(.Cells(x, 3).Value)) = .Cells(x, 1).Value & delim & .Cells(x, 2).Value[/TD]
[/TR]
[TR]
[TD] Next x[/TD]
[/TR]
[TR]
[TD] End With[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] With ws1[/TD]
[/TR]
[TR]
[TD] x = .Cells(.Rows.Count, 3).End(xlUp).Row[/TD]
[/TR]
[TR]
[TD] arr = .Cells(2, 1).Resize(x - 1, 4).Value
[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] For x = LBound(arr, 1) To UBound(arr, 1)
[/TD]
[/TR]
[TR]
[TD] If dic.exists(.Cells(x + 1, 3).Value) Then[/TD]
[/TR]
[TR]
[TD] temp = Split(dic(.Cells(x + 1, 3).Value), delim)[/TD]
[/TR]
[TR]
[TD] arr(x, 1) = temp(0)[/TD]
[/TR]
[TR]
[TD] arr(x, 2) = temp(1)[/TD]
[/TR]
[TR]
[TD] Erase temp[/TD]
[/TR]
[TR]
[TD] Else
[/TD]
[/TR]
[TR]
[TD] arr(x, 1) = Empty[/TD]
[/TR]
[TR]
[TD] arr(x, 2) = Empty[/TD]
[/TR]
[TR]
[TD] End If[/TD]
[/TR]
[TR]
[TD] Next x[/TD]
[/TR]
[TR]
[TD]
[/TD]
[/TR]
[TR]
[TD] .Cells(2, 1).Resize(UBound(arr, 1), UBound(arr, 2)).Value2 = arr
[/TD]
[/TR]
[TR]
[TD] End With[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] Application.ScreenUpdating = True[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD] Set dic = Nothing[/TD]
[/TR]
[TR]
[TD] Set ws1 = Nothing[/TD]
[/TR]
[TR]
[TD] Set ws2 = Nothing[/TD]
[/TR]
[TR]
[TD] Erase arr[/TD]
[/TR]
[TR]
[TD] [/TD]
[/TR]
[TR]
[TD]End Sub
[/TD]
[/TR]
</tbody>[/TABLE]

 

[JackDanIce]

Glad it's working and resolved.