Looking for differences in two Cols using VBA

[swaink]

Hi All

With the help of Fairwinds I have managed to achieve part of my aim but I would now like to look at this issue to see if I may use VBA to meet my needs.

I have browsed and found some sample code but I'm experiencing some prolems with it. Basically I need to compare Col B with Col E, In Col H I want to show numbers that appear in Col B but not in Col E and also place the corresponding Ref number in Col G.

Having done this I then look at the same Cols and place the Numbers which Appear in Col E but not B and place those details in Cols J & K

This piece of code is failing me in that it is posting values that do appear in both Cols, Would someone please be able to advise me on how I may adjust the code accordingly

Best regards

Kevin



Sub test()
Dim rng1 As Range
Dim rng2 As Range
Dim c As Range
Dim i As Integer
Set rng1 = Range("B3", Range("B3").End(xlDown))
Set rng2 = Range("E3", Range("E3").End(xlDown))
For Each c In rng1
On Error Resume Next
i = WorksheetFunction.Match(c, rng2, 0) + 2
If Err.Number > 0 Then
Range(Cells(i, 1), Cells(i, 2)).Copy _
Range("g65536").End(xlUp).Offset(1, 0)
ActiveCell.Paste

Else
On Error GoTo 0
End If
Next c
End Sub

DHLGMRPT (version 1).xls
	A	B	C	D	E	F	G	H	I
1	Sheet1			Sheet2			In sheet 1 but not in sheet 2
2	Ref no	Item no		Ref no	Item no
3	7613	365471241617		7613	365471241617		7788	365471241655
4	7255	365471241624		7255	365471241624		7255	365471241624
5	7260	365471241631		7260	365471241648		7788	365471241648
6	7788	365471241648		7788	365471241655		7788	365471241655
7	7788	365471241655		7788	365471241679
8	7788	365471241662		7788	365471241704
9	7613	365471241679		7613	365471241705
10	7255	365471241686		7255	365471241706
11
12
VBA

 

[fairwinds]

Hi,

You could use advanced filter in your code e.g:

Sub xxx()

Range("M2").Formula = "=ISNA(MATCH(B3,$E$3:$E$100,0))"
Range("A2:B100").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"M1:M2"), CopyToRange:=Range("G2:H2"), Unique:=False

Range("M2").Formula = "=ISNA(MATCH(E3,$B$3:$B$100,0))"
Range("D2:E100").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
"M1:M2"), CopyToRange:=Range("J2:K2"), Unique:=False

Range("M2").ClearContents

End Sub

 

[swaink]

Hi Fairwinds

I've given it a go but it just repeats what I have in each column

What I'm expecting to see is this.

All the best

Kev

DHLGMRPT.0002.xls
	D	E	F	G	H
26	In sheet1 not In sheet 2		In Sheet 2 not in Sheet 1
27
28	7288	999471284999	7287	395499284485
29	7612	365471284515	7288	365471284393
30	7288	365471284409	7288	365471284416
31	7635	365471284423	7614	399971284591
32	7764	365471284645	7635	365471284430
33	7641	365471284454	7764	399471284599
34
Sheet3

 

[swaink]

Hi All

Fairwinds thank you for your input it is appreciated, I have spent several hours now and finally got my head around it, thanks to a post by Phantom1975 I have managed to use his code with a few changes and it now does the job.

As its taken so long to reach this end result I felt I ought to post it back here should anyone else need to do something similar.

So thanks again to Fairwinds and Phanton1975

All the best

Kevin

Sub CompareColumnsBtoE()
Application.ScreenUpdating = False
Dim r As Integer
Dim rr As Integer
Dim rrr As Integer
Dim ThisNum As Boolean
Range("G3", Range("H3").End(xlDown)).ClearContents

rrr = 1
For r = 1 To Range("B65536").End(xlUp).Row
ThisNum = False
For rr = 1 To Range("E65536").End(xlUp).Row
If Range("E" & rr).Value = Range("B" & r).Value Then
ThisNum = True
Exit For
End If
Next rr

If ThisNum = False Then
Range(Cells(r, 1), Cells(r, 2)).Copy _
Range("G65536").End(xlUp).Offset(1, 0)

rrr = rrr + 1
Application.CutCopyMode = False
End If
Next
Range("B3").Select
Application.ScreenUpdating = True
End Sub

Sub CompareColumnsEtoB()
Application.ScreenUpdating = False
Dim r As Integer
Dim rr As Integer
Dim rrr As Integer
Dim ThisNum As Boolean
Range("J3", Range("K3").End(xlDown)).ClearContents

rrr = 1
For r = 1 To Range("E65536").End(xlUp).Row
ThisNum = False
For rr = 1 To Range("B65536").End(xlUp).Row
If Range("E" & r).Value = Range("B" & rr).Value Then
ThisNum = True
Exit For
End If
Next rr

If ThisNum = False Then
Range(Cells(r, 4), Cells(r, 5)).Copy _
Range("J65536").End(xlUp).Offset(1, 0)
rrr = rrr + 1
Application.CutCopyMode = False
End If
Next
Range("B3").Select
Application.ScreenUpdating = True
End Sub
[/quote]

 

[fairwinds]

Hi,

I do not see why the code using advanced filter should not work. In the expected result you post, I can see numbers that are neither in sheet1 nor in sheet2 so...

However, you did find a solution by yourself so I guess all is well. Good job!