This one is readable, please help me!

[Brian Madsen]

I 'm in dire need of a solution to this problem, I need to match sheet1 to
sheet 2 by entire rows and show the non matching rows on sheet3. Any help
with this would be greatly appreciated. I've been working this for a week
and cannot come up with a solution.

Should look like:
Sheet 1 Sheet 2

1 2 3 4 1 2 3 4
2 3 4 5 2 3 4 5
6 7 8 9 6 7 8 8
a b c d a b c d
e f g h e f h g

Sheet 3
6 7 8 8
6 7 8 9
e f g h
e f h g

 

[keepITcool]

Brian,

Following code works.. BUT

I've used transpose worksheetfunction, which will work fine in xlXP and
newer but is unreliable for large arrays in earlier versions.

Alternatively you can write to the destination range directly iso
filling an array first.

you should include some tests to check that rng3 is empty before
dumping the data...

if you generally find more differences you could increase the redim's
stepsize

Have Fun!


Option Explicit

Sub QnDtest()
Call SimpleCompare( _
Range("sheet1!a1:d5000"), _
Range("sheet2!a1:d5000"), _
Range("sheet3!a1"))

End Sub

Sub SimpleCompare(rng1 As Range, rng2 As Range, rngDest As Range)
Dim r As Long, rMM As Long, c As Long, cMM As Long, cMax As Long
Dim vaMM() As Variant


If rng1.Rows.Count <> rng2.Rows.Count Or _
rng1.Columns.Count <> rng2.Columns.Count Then
MsgBox "Ranges have different size"
Exit Sub
End If

cMax = rng1.Columns.Count

'Since the rowcount is undetermined, we need to work
'with a 'transposed' array so we can redim it.

ReDim vaMM(1 To cMax, 1 To 10)


For r = 1 To rng1.Rows.Count
For c = 1 To rng1.Columns.Count
If rng1(r, c).Value2 <> rng2(r, c).Value2 Then
GoSub mismatch
Exit For
End If
Next
Next

'Set the array to the correct size
ReDim Preserve vaMM(1 To cMax, 1 To rMM)

'Transpose and write it to rngDest
rngDest.Resize(rMM, cMax) = Application.Transpose(vaMM)
Exit Sub

mismatch:
rMM = rMM + 2
If rMM > UBound(vaMM, 2) Then
ReDim Preserve vaMM(1 To cMax, 1 To UBound(vaMM, 2) + 10)
End If

For cMM = 1 To cMax
vaMM(cMM, rMM - 1) = rng1(r, cMM).Value
vaMM(cMM, rMM) = rng2(r, cMM).Value
Next
Return


End Sub



keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[Brian Madsen]

Thanks for the reply. I'm looking at the results, but it seems to be picking
up all of the cells and isn't differentiating between matches and
non-matches. I only need the non-matches on sheet 3. What am I doing wrong?