VB Solution for a INDEX Array Problem

[Ananth]

I have a Master Tab Showing (the table has 1000 records)

BU_CD CY_CD Cntry_CD Att_1 Att_2 Att_3 Att_4
A01 SOC UK XX1 YY1 ZZ1 XY1
A02 SHL NL XX2 YY2 ZZ2 XY2
A03 BPC IR XX3 YY3 ZZ3 XY3
A04 IOC UK XX4 YY4 ZZ4 XY4

I have another tab showing month transactions that has 40000 rows and 60
Columns of information, pulled out from the ERP system. This ERP info has
BU_CD, CY_CD and Country_CD. Using these three combination keys, I have to
populate Column 61 to Column 64 with Attribute_1 to Attribute_4 from the
Master Tab. I want to achieve this with VB as the Index & Match function
(array) takes its own sweet time to complete and sometimes Excel gets
frustrated and returns a message “Not responding†I am not for using
Vlookup as it would require altering table structure.

Any help is appreciated

 

[Sheeloo]

with the assumptions:
both sheet sorted on BU_CD x CY_CD x Cntry_CD
BU_CD x CY_CD x Cntry_CD in the details sheet definitely present in MASTER
(sheet1) try the macro below

Sub Transpose()
Dim lastRow, lastCol As Long
Dim dataSheet As String
Dim dataId, lookupId As String
Dim lookupSheet As String
Dim i, j, k As Long
Application.ScreenUpdating = False
dataSheet = "Sheet2"
lookupSheet = "Sheet1"
Worksheets(dataSheet).Activate
With Worksheets(dataSheet)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
dataId = ""
lookupId = ""
j = 2
For i = 2 To lastRow
dataId = Sheets(dataSheet).Cells(i, 1) & Sheets(dataSheet).Cells(i, 2) _
& Sheets(dataSheet).Cells(i, 3)

Do While (dataId <> lookupId)
lookupId = Sheets(lookupSheet).Cells(j, 1) & Sheets(lookupSheet).Cells(j, 2) _
& Sheets(lookupSheet).Cells(j, 3)

j = j + 1
Loop
Sheets(dataSheet).Cells(i, 61) = Worksheets(lookupSheet).Cells(j - 1, 4)
Sheets(dataSheet).Cells(i, 62) = Worksheets(lookupSheet).Cells(j - 1, 5)
Sheets(dataSheet).Cells(i, 63) = Worksheets(lookupSheet).Cells(j - 1, 6)
Sheets(dataSheet).Cells(i, 64) = Worksheets(lookupSheet).Cells(j - 1, 7)
Next i
Worksheets(dataSheet).Activate
Application.ScreenUpdating = True
End Sub