HELP! Cant figure out how to modify code based on new requirement

[Footprints]

Hello,
I got the majority of the code below from this site. I made some slight modifications because I wanted the Matching, OnSheet1Only and OnSheet2Only information to appear on three different worksheets. I was able to get that to work perfectly but am having trouble modifying the code in order to extend the amount of information that is "copied" (included on each of the 3 worksheets). For each of the 3 worksheets I mentioned above, it currently only lists the value of Column A. I would like the coding to include the values through the last column of the applicable range.


For the "Match" worksheet I would like it to include the values from rng2 whenever the match is found in Column A (all through Column N).
For the worksheet OnSheet1Only, the unmatched values from rng1 should be copied through the last column
For the worksheet OnSheet2Only, the unmatched values from rng2 should be copied through the last column.


Can anyone please help me modify the code to achieve this? This would be greatly appreciated!

Sample data 4-7-2020.xlsm

[Bob Phillips]

Sub modified_compare_match_unmatch()
Dim rng1 As Range, rng2 As Range
Dim LastRow1 As Long, LastRow2 As Long, i As Long

    With Worksheets("OnSheet1Only")
        .Range("A2:N" & Rows.Count).Clear
        .Range("A2:N" & Rows.Count).NumberFormat = "@"
    End With

    With Worksheets("OnSheet2Only")
        .Range("A2:N" & Rows.Count).Clear
        .Range("A2:N" & Rows.Count).NumberFormat = "@"
    End With

    With Worksheets("Match")
        .Range("A2:N" & Rows.Count).Clear
        .Range("A2:N" & Rows.Count).NumberFormat = "@"
    End With

    With Worksheets("Sheet1")
       LastRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
       Set rng1 = .Range("A2:A" & LastRow1)
    End With
    
    With Worksheets("Sheet2")
        LastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
        Set rng2 = .Range("A2:A" & LastRow2)
    End With
    
    With Worksheets("Sheet1")
        For i = 2 To LastRow1
            .Range("A" & i).Copy
            If Application.CountIf(rng2, .Range("A" & i).Value) > 0 Then
                Worksheets("Match").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 10).PasteSpecial Paste:=xlPasteValues
            Else
                Worksheets("OnSheet1Only").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 10).PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    End With
    
    With Worksheets("Sheet2")
        For i = 2 To LastRow2
            If Application.CountIf(rng1, .Range("A" & i).Value) = 0 Then
                .Range("A" & i).Resize(, 14).Copy
                Worksheets("OnSheet2Only").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 14).PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    End With
    
    MsgBox "Sheet1 Number of Positions -" & vbTab & ActiveWorkbook.Worksheets("Sheet1").UsedRange.Rows.Count - 1 & vbCr & _
            "Sheet 2 Number of Positions-" & vbTab & ActiveWorkbook.Worksheets("Sheet2").UsedRange.Rows.Count - 1 & vbCr & _
            "MATCHED -" & vbTab & ActiveWorkbook.Worksheets("Match").UsedRange.Rows.Count - 1 & vbCr & _
            "UnMatched from Sheet1-" & vbTab & ActiveWorkbook.Worksheets("OnSheet1Only").UsedRange.Rows.Count - 1 & vbCr & _
            "UnMatched from Sheet2 -" & vbTab & ActiveWorkbook.Worksheets("OnSheet2Only").UsedRange.Rows.Count - 1
End Sub

[Footprints]

Hi Xld,
I modified your coding a bit since it worked for the OnSheet2Only but not for the others. I just had to add the copy line (".Range("A" & i).Resize(, 14).Copy") and now it does what you intended it to.

However, for the Match worksheet, I wanted it to copy the values from Range rng2 not rng1. The Match worksheet should list all matching rows based on the value of Column A but include the remaining values from Sheet2, not Sheet 1 as it currently does.

Thank you for your input. Would you be able to look into this further?

Sample data 4-7-2020.xlsm

[Bob Phillips]

I am not sure that I fully understand the brief, but is this what you mean?

Sub modified_compare_match_unmatch()
Dim rng1 As Range, rng2 As Range
Dim LastRow1 As Long, LastRow2 As Long, i As Long

    Application.ScreenUpdating = False
    
    Worksheets("OnSheet1Only").Range("A2:N" & Rows.Count).Clear
    Worksheets("OnSheet1Only").Range("A2:N" & Rows.Count).NumberFormat = "@"

    Worksheets("OnSheet2Only").Range("A2:N" & Rows.Count).Clear
    Worksheets("OnSheet2Only").Range("A2:N" & Rows.Count).NumberFormat = "@"

    Worksheets("Match").Range("A2:N" & Rows.Count).Clear
    Worksheets("Match").Range("A2:N" & Rows.Count).NumberFormat = "@"

    With Worksheets("Sheet1")
       LastRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
       Set rng1 = .Range("A2:A" & LastRow1)
    End With
    
    With Worksheets("Sheet2")
        LastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
        Set rng2 = .Range("A2:A" & LastRow2)
    End With
    
    With Worksheets("Sheet1")
        For i = 2 To LastRow1
            .Range("A" & i).Resize(, 10).Copy
            Worksheets("OnSheet1Only").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 10).PasteSpecial Paste:=xlPasteValues
        Next i
    End With
    
    With Worksheets("Sheet2")
        For i = 2 To LastRow2
            .Range("A" & i).Resize(, 14).Copy
            If Application.CountIf(rng2, .Range("A" & i).Value) > 0 Then
                Worksheets("Match").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 14).PasteSpecial Paste:=xlPasteValues
            ElseIf Application.CountIf(rng1, .Range("A" & i).Value) = 0 Then
                Worksheets("OnSheet2Only").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(, 14).PasteSpecial Paste:=xlPasteValues
            End If
        Next i
    End With

    Application.ScreenUpdating = True
    
    MsgBox "Sheet1 Number of Positions -" & vbTab & Worksheets("Sheet1").UsedRange.Rows.Count - 1 & vbCr & _
           "Sheet 2 Number of Positions-" & vbTab & Worksheets("Sheet2").UsedRange.Rows.Count - 1 & vbCr & _
           "MATCHED -" & vbTab & vbTab & Worksheets("Match").UsedRange.Rows.Count - 1 & vbCr & _
           "UnMatched from Sheet1 -" & vbTab & Worksheets("OnSheet1Only").UsedRange.Rows.Count - 1 & vbCr & _
           "UnMatched from Sheet2 -" & vbTab & Worksheets("OnSheet2Only").UsedRange.Rows.Count - 1, vbInformation
End Sub