Match data on 2 different sheets using a KEY
Copy data from corresponding row and paste on original sheet
Sub MatchValue_ApplyStandardCode()
Dim Ws1 As Long, Ws2 As Long, iRe1 As Long, iRe2 As Long, iCe1 As Long, iCe2 As Long, iLoop As Long, R1 As Long, R2 As Long
Dim Ws1MatchCol As Long, Ws2MatchCol As Long, Ws1DumpCol As Long, Ws2CopyCol As Long
Dim sWs1Val As String, sWs2Val As String
Dim aData() As Variant, aCopy() As Variant, aMatch() As Variant, aDump() As Variant
Erase aData: Erase aCopy: Erase aMatch: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = Worksheets("Update").Index
iRe1 = Range(GetLastCell(Ws1)).Row
iCe1 = Range(GetLastCell(Ws1)).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws2 = Worksheets("Conversion").Index
iRe2 = Range(GetLastCell(Ws2)).Row
iCe2 = Range(GetLastCell(Ws2)).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Set Column Locations:
'===================================================================================================
Worksheets(Ws1).Select
Ws1MatchCol = Application.InputBox(Prompt:="What Column contains the value to match[UPDATE - Upload Value(B)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 2).Address, Type:=8).Column
Ws1DumpCol = Application.InputBox(Prompt:="What Column will update with [DUMP-CODE(A)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 1).Address, Type:=8).Column
Worksheets(Ws2).Select
Ws2MatchCol = Application.InputBox(Prompt:="What Column contains the value to match[CONVERSION - Value(A)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 1).Address, Type:=8).Column
Ws2CopyCol = Application.InputBox(Prompt:="What Column contains the value to [COPY-(F)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 6).Address, Type:=8).Column
If Ws1MatchCol = 0 Or Ws1DumpCol = 0 Or Ws2MatchCol = 0 Or Ws2CopyCol = 0 Then GoTo HeaderNotSetAbandonAllHope
'===================================================================================================
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, Ws1MatchCol).Address, Worksheets(Ws1).Cells(iRe1, Ws1MatchCol).Address)
aDump = Range(Worksheets(Ws1).Cells(1, Ws1DumpCol).Address, Worksheets(Ws1).Cells(iRe1, Ws1DumpCol).Address)
Worksheets(Ws2).Select
aMatch = Range(Worksheets(Ws2).Cells(1, Ws2MatchCol).Address, Worksheets(Ws2).Cells(iRe2, Ws2MatchCol).Address)
aCopy = Range(Worksheets(Ws2).Cells(1, Ws2CopyCol).Address, Worksheets(Ws2).Cells(iRe2, Ws2CopyCol).Address)
'===================================================================================================
'===================================================================================================
'Clean up any residual data (In case of multiple matching attemps)
For iLoop = LBound(aDump) + 1 To UBound(aDump)
aDump(iLoop, 1) = ""
Next iLoop
'===================================================================================================
'===================================================================================================
For R1 = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(R1, 2) = "00" Then Application.StatusBar = R1 & " of " & UBound(aData)
sWs1Val = aData(R1, 1)
For R2 = LBound(aMatch) + 1 To UBound(aMatch)
sWs2Val = aMatch(R2, 1)
If sWs1Val = sWs2Val Then
aDump(R1, 1) = aCopy(R2, 1)
End If
Next R2
Next R1
'===================================================================================================
'===================================================================================================
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, Ws1DumpCol).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
GoTo EraseMemoryPlease
Exit Sub
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
HeaderNotSetAbandonAllHope:
Debug.Print "Check for missing header"
GoTo EraseMemoryPlease
Exit Sub
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
EraseMemoryPlease:
Erase aData: Erase aCopy: Erase aMatch: Erase aDump
Application.StatusBar = ""
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Sub
Dim Ws1 As Long, Ws2 As Long, iRe1 As Long, iRe2 As Long, iCe1 As Long, iCe2 As Long, iLoop As Long, R1 As Long, R2 As Long
Dim Ws1MatchCol As Long, Ws2MatchCol As Long, Ws1DumpCol As Long, Ws2CopyCol As Long
Dim sWs1Val As String, sWs2Val As String
Dim aData() As Variant, aCopy() As Variant, aMatch() As Variant, aDump() As Variant
Erase aData: Erase aCopy: Erase aMatch: Erase aDump
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws1 = Worksheets("Update").Index
iRe1 = Range(GetLastCell(Ws1)).Row
iCe1 = Range(GetLastCell(Ws1)).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
Ws2 = Worksheets("Conversion").Index
iRe2 = Range(GetLastCell(Ws2)).Row
iCe2 = Range(GetLastCell(Ws2)).Column
'OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
'Set Column Locations:
'===================================================================================================
Worksheets(Ws1).Select
Ws1MatchCol = Application.InputBox(Prompt:="What Column contains the value to match[UPDATE - Upload Value(B)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 2).Address, Type:=8).Column
Ws1DumpCol = Application.InputBox(Prompt:="What Column will update with [DUMP-CODE(A)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 1).Address, Type:=8).Column
Worksheets(Ws2).Select
Ws2MatchCol = Application.InputBox(Prompt:="What Column contains the value to match[CONVERSION - Value(A)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 1).Address, Type:=8).Column
Ws2CopyCol = Application.InputBox(Prompt:="What Column contains the value to [COPY-(F)]?", Title:="Specify Column by Clicking on ANY Cell within that Column", Default:=Cells(1, 6).Address, Type:=8).Column
If Ws1MatchCol = 0 Or Ws1DumpCol = 0 Or Ws2MatchCol = 0 Or Ws2CopyCol = 0 Then GoTo HeaderNotSetAbandonAllHope
'===================================================================================================
'===================================================================================================
Worksheets(Ws1).Select
aData = Range(Worksheets(Ws1).Cells(1, Ws1MatchCol).Address, Worksheets(Ws1).Cells(iRe1, Ws1MatchCol).Address)
aDump = Range(Worksheets(Ws1).Cells(1, Ws1DumpCol).Address, Worksheets(Ws1).Cells(iRe1, Ws1DumpCol).Address)
Worksheets(Ws2).Select
aMatch = Range(Worksheets(Ws2).Cells(1, Ws2MatchCol).Address, Worksheets(Ws2).Cells(iRe2, Ws2MatchCol).Address)
aCopy = Range(Worksheets(Ws2).Cells(1, Ws2CopyCol).Address, Worksheets(Ws2).Cells(iRe2, Ws2CopyCol).Address)
'===================================================================================================
'===================================================================================================
'Clean up any residual data (In case of multiple matching attemps)
For iLoop = LBound(aDump) + 1 To UBound(aDump)
aDump(iLoop, 1) = ""
Next iLoop
'===================================================================================================
'===================================================================================================
For R1 = LBound(aData) + 1 To UBound(aData)
DoEvents
If Right(R1, 2) = "00" Then Application.StatusBar = R1 & " of " & UBound(aData)
sWs1Val = aData(R1, 1)
For R2 = LBound(aMatch) + 1 To UBound(aMatch)
sWs2Val = aMatch(R2, 1)
If sWs1Val = sWs2Val Then
aDump(R1, 1) = aCopy(R2, 1)
End If
Next R2
Next R1
'===================================================================================================
'===================================================================================================
Worksheets(Ws1).Select
Set Destination = Range(Worksheets(Ws1).Cells(1, Ws1DumpCol).Address)
Destination.Resize(UBound(aDump, 1), UBound(aDump, 2)).Value = aDump
'===================================================================================================
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
GoTo EraseMemoryPlease
Exit Sub
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
HeaderNotSetAbandonAllHope:
Debug.Print "Check for missing header"
GoTo EraseMemoryPlease
Exit Sub
'EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
EraseMemoryPlease:
Erase aData: Erase aCopy: Erase aMatch: Erase aDump
Application.StatusBar = ""
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
End Sub