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: