Hello
I found the below VBA code to find the matches, unfortunately, it copied to the wrong place. Instead I need the matches, copy its corresponding value to column D from "Data" worksheet to the "Master" worksheet. For example, in "Data" worksheet the Code ABC is 3534, it should then copy only the value to the "Master" worksheet's D column. Please help.
Master worksheet
A B C D E
Code Orange Apple Total
ABC 123.00 567.00 690.00
DEF 57,974.34 - 57,974.34
GHI 58,490.00 8.00 58,498.00
MNO 4.00 571.00 575.00
LOK 7,604.00 899.00 8,503.00
MKO - - -
MIL 1,674.00 - 1,674.00
FRE 13,415.12 - 13,415.12
Data worksheet
Code Total
ABC 3534
DEF 12276
GHI 3248
IN0019 11726
IN0020 1984
LOK 55
MIL 1472
MNO 10384
Grand Total 121047
Option Explicit
Private Const MASTER_B_COL_IDX As Integer = 2
Private Const DATA_A_COL_IDX As Integer = 1
Public Sub FindMatchingData()
Dim MasterWrkSh As Worksheet
Dim MasterColCount As Integer
Dim MasterRowCount As Long
Dim MasterCol As Integer
Dim MasterRow As Long
Dim DataWrkSh As Worksheet
Dim DataColCount As Integer
Dim DataRowCount As Long
Dim DataRow As Long
Dim CopyData As Integer
Dim PrintData As Integer
Dim Data() As Variant
Set MasterWrkSh = Sheets("Master")
Set DataWrkSh = Sheets("Data")
MasterColCount = MasterWrkSh.UsedRange.Columns.Count
MasterRowCount = MasterWrkSh.UsedRange.Rows.Count
DataColCount = DataWrkSh.UsedRange.Columns.Count
DataRowCount = DataWrkSh.UsedRange.Rows.Count
ReDim Data(DataColCount, 0)
For MasterRow = 1 To MasterRowCount
Application.StatusBar = Format(MasterRow / MasterRowCount, "0 %")
DoEvents
For DataRow = 1 To DataRowCount
If MasterWrkSh.Cells(MasterRow, MASTER_B_COL_IDX) = _
DataWrkSh.Cells(DataRow, DATA_A_COL_IDX) Then
ReDim Preserve Data(DataColCount, UBound(Data, 2) + 1)
Data(0, UBound(Data, 2)) = MasterRow
For CopyData = 1 To DataColCount
Data(CopyData, UBound(Data, 2)) = DataWrkSh.Cells(DataRow, CopyData)
Next
Exit For
End If
Next
Next
For PrintData = 1 To UBound(Data, 2)
For MasterCol = 1 To UBound(Data, 1)
MasterWrkSh.Cells(Data(0, PrintData), MasterCol + MasterColCount) = Data(MasterCol, PrintData)
Next
Next
Set DataWrkSh = Nothing
Set MasterWrkSh = Nothing
End Sub
Bookmarks