VBA - compare cell against column in diff sheets

C

Collywobbles

I have been asked by a friend to complete this and Im having difficulty with
it. He wants to see if a number value in each cell of Sheet1.ColumnE is in
any of the cells of Sheet2.ColumnE. If it is not then print the whole row
(from Sheet1) to Sheet3 (next available row). I have tried the following
code but it only returns the unique values in Sheet1.ColumnE and not the
whole row from Sheet1.
This would be easy via MS Access but he can't use that!
Cheers
Killian

---------------
Sub RunMe()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cll As Range

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")

Set rng1 = sht1.Range(sht1.Cells(1, 5), sht1.Cells(65536, 5).End(xlUp))
Set rng2 = sht2.Range(sht2.Cells(1, 5), sht2.Cells(65536, 5).End(xlUp))

For Each cll In rng1.Cells
If rng2.Find(cll.Value, LookAt:=xlWhole) Is Nothing Then
Worksheets("Sheet3").Cells(65536, 5).End(xlUp).Offset(1).Value = cll.Value
End If
Next cll
End Sub
 
B

Bob Phillips

Hi Colly,

Here is a working version

Sub RunMe()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cll As Range
Dim j As Long

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
Set sht3 = Worksheets("Sheet3")

Set rng1 = sht1.Range(sht1.Cells(1, "E"), sht1.Cells(Rows.Count,
"E").End(xlUp))
Set rng2 = sht2.Range(sht2.Cells(1, "E"), sht2.Cells(Rows.Count,
"E").End(xlUp))

For Each cll In rng1.Cells
If Not rng2.Find(cll.Value, LookAt:=xlWhole) Is Nothing Then
j = j + 1
cll.EntireRow.Copy Destination:=sht3.Cells(j, "A")
End If
Next cll
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
C

Collywobbles

Thanks a million Bob but this lists the values in Sht1 that are also in
Sht2. What do I change to list the values in Sht1 not in Sht2.
Killian
 
B

Bob Phillips

Hi Killian,

Sorry about that, a rather basic typo. Here is the correct (I hope<G>)
version

Sub RunMe()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim cll As Range
Dim j As Long

Set sht1 = Worksheets("Sheet1")
Set sht2 = Worksheets("Sheet2")
Set sht3 = Worksheets("Sheet3")

Set rng1 = sht1.Range(sht1.Cells(1, "E"), sht1.Cells(Rows.Count,
"E").End(xlUp))
Set rng2 = sht2.Range(sht2.Cells(1, "E"), sht2.Cells(Rows.Count,
"E").End(xlUp))

For Each cll In rng1.Cells
If rng2.Find(cll.Value, LookAt:=xlWhole) Is Nothing Then
j = j + 1
cll.EntireRow.Copy Destination:=sht3.Cells(j, "A")
End If
Next cll
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
C

Collywobbles

Never mind - I took the Not out of the If statement and it works great.
Thanks again
K.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top