Find and copy cells from adjacent worksheet to current worksheet - function

Question

I need to create a macro (or function) to copy cells from an adjacent worksheet to the current worksheet if they meet certain criteria.
Below is the worksheet adjacent to the current worksheet that contains the Owner, Ticket, and Comments fields. I need to copy those fields to the appropriate application name and object (Concatenated as a unique ID) in the current worksheet.
Below is the current worksheet that I need to copy the above fields to. Notice that the applications are not listed in the same order. This will be the case as I never know which order the data will be in or if the same data will even be in the new worksheet.
So far I have tried this function:
=IF(INDIRECT(NextSheetName()&"!A3")&INDIRECT(NextSheetName()&"!B3") = A3&B3, INDIRECT(NextSheetName()&"!D3"), "0")
Which will work only in the case that the worksheets have the same data in the same order.
Does anyone have any idea how this can be done?

Answer 1

If you want to do this using VBA, try the following. The code copies matching rows from the source worksheet to the target worksheet and records the matching row on the source to the target, in case you find that useful. I named my sheets "Source" and "Target" and am assuming that you are wanting to match on the concatenation of columns A and B.
The number of rows in your source and target don't matter, nor does the order in which the matches appear.
I wrote two different versions. The first works, but I'm not crazy about it because it loops through the source range looking for a match for each value in the target. The second version uses a dictionary that is built once. Matching search terms is then done without having to loop through a range. Note that to use the dictionary, you'll need a reference to the Microsoft Scripting Runtime.
First Version: (functional, but requires multiple loops)
Sub GetTwoColumnMatches()
Dim wsrc As Worksheet
Dim wTgt As Worksheet
Dim rng As Range
Dim cell As Range
Dim lLastTargetRow As Long
Dim lMatchedRow As Long
Dim sConcat As String
Set wsrc = Sheets("Source")
Set wTgt = Sheets("Target")
lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row
Set rng = wTgt.Range("a2:a" & lLastTargetRow)
For Each cell In rng
sConcat = cell & cell.Offset(, 1)
lMatchedRow = Matches(sConcat)
If lMatchedRow <> 0 Then
wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
wTgt.Range("f" & cell.Row) = lMatchedRow
End If
Next
End Sub
Function Matches(SearchFor As String) As Long
Dim wsrc As Worksheet
Dim rng As Range
Dim cell As Range
Dim lLastSourceRow As Long
Dim lSourceRow As Long
Set wsrc = Sheets("Source")
lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row
Set rng = wsrc.Range("a2:a" & lLastSourceRow)
Matches = 0
For Each cell In rng
If cell & cell.Offset(, 1) = SearchFor Then
Matches = cell.Row
Exit For
End If
Next
End Function
Second Version: (optimized, requires reference to Microsoft Scripting Runtime)
Sub GetTwoColumnMatches()
Dim wsrc As Worksheet
Dim wTgt As Worksheet
Dim rng As Range
Dim cell As Range
Dim srcRng As Range
Dim srcCell As Range
Dim lLastTargetRow As Long
Dim lLastSourceRow As Long
Dim lMatchedRow As Long
Dim lSourceRow As Long
Dim sConcat As String
Dim dict As Dictionary
Set wsrc = Sheets("Source")
Set wTgt = Sheets("Target")
lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row
Set wsrc = Sheets("Source")
lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row
'Create the dictionary
Set dict = New Dictionary
Set srcRng = wsrc.Range("a2:b" & lLastSourceRow)
For Each srcCell In srcRng
sConcat = srcCell & srcCell.Offset(, 1)
If Len(sConcat) > 0 Then dict.Add sConcat, srcCell.Row
Next
Set rng = wTgt.Range("a2:a" & lLastTargetRow)
For Each cell In rng
sConcat = cell & cell.Offset(, 1)
lMatchedRow = dict.Item(sConcat)
If lMatchedRow <> 0 Then
wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
wTgt.Range("f" & cell.Row) = lMatchedRow
End If
Next
End Sub
Here's what your references will look like once you've correctly selected the Microsoft Scripting Runtime: