ekryez
02-05-2015, 01:18 PM
Sub divide()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheets("a")
Set sh2 = Sheets("b")
Set sh3 = Sheets("Result")
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1)
Set rng2 = sh2.Range("A2:A" & lr2)
With sh3 'If header not there, put them in
If .Range("A1") = "" And .Range("B1") = "" Then
.Range("A1") = "New"
.Range("B1") = "Removed"
End If
......."Same"
End With
For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
End If
Next
For Each c In rng2
If Application.CountIf(rng1, c.Value) = 0 Then
sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
End If
Next
End Sub
Can someone help modifying this code. All in same Worksheet, instead of 3
First - The Range to be input ie
InputBox ("Enter the Range: ")
and
adding a third loop displaying the same items in both lists
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr1 As Long, lr2 As Long, rng1 As Range, rng2 As Range, c As Range
Set sh1 = Sheets("a")
Set sh2 = Sheets("b")
Set sh3 = Sheets("Result")
lr1 = sh1.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng1 = sh1.Range("A2:A" & lr1)
Set rng2 = sh2.Range("A2:A" & lr2)
With sh3 'If header not there, put them in
If .Range("A1") = "" And .Range("B1") = "" Then
.Range("A1") = "New"
.Range("B1") = "Removed"
End If
......."Same"
End With
For Each c In rng1 'Run a loop for each list ID mismatches and paste to sheet 3.
If WorksheetFunction.CountIf(rng2, c.Value) = 0 Then
sh3.Cells(Rows.Count, 1).End(xlUp)(2) = c.Value
End If
Next
For Each c In rng2
If Application.CountIf(rng1, c.Value) = 0 Then
sh3.Cells(Rows.Count, 2).End(xlUp)(2) = c.Value
End If
Next
End Sub
Can someone help modifying this code. All in same Worksheet, instead of 3
First - The Range to be input ie
InputBox ("Enter the Range: ")
and
adding a third loop displaying the same items in both lists