View Full Version : HELP! Cant figure out how to modify code based on new requirement
Footprints
04-07-2020, 10:19 AM
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
04-07-2020, 10:55 AM
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
04-07-2020, 11:15 AM
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
04-07-2020, 03:07 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.