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!

26293

[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?

26295

[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