ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Matching rows for differences (https://www.excelbanter.com/excel-programming/310482-matching-rows-differences.html)

Brian Madsen

Matching rows for differences
 
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.



Sheet 1 Sheet 2
Sheet3


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



Brian Madsen

Matching rows for differences
 

"Brian Madsen" wrote in message
ink.net...
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.



Sheet 1 Sheet 2
Sheet3


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

(Whoops, looks like I'm also in need of a formatting tutor)
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



Alex J

Matching rows for differences
 
OK. I'll bite.

Basic Strategy:
1. Read the data from each of sheets 1 and 2 into arrays.
2. Compare row by row, and identify mismatches
3. Create an array of the mismatched and write to sheet 3

Basic questions:
1. Do we need to check to see if a row on sheet1 exists on sheet2, or do we
need to add a check to ensure that rows on sheet2 exist on sheet1?
2. I assume that row checking means verify exactly the same value in the
same column on each sheet?
Let me know.

Alex J


"Brian Madsen" wrote in message
ink.net...

"Brian Madsen" wrote in message
ink.net...
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.



Sheet 1 Sheet 2
Sheet3


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

g

(Whoops, looks like I'm also in need of a formatting tutor)
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





Alex J

Matching rows for differences
 
Try This ( I have tested, but I'm not positive it will be logically correct
for every possible case)
AlexJ

Dim xc1 As New Collection
Dim xc2 As New Collection
Dim xc3 As New Collection
Dim cols As Long

Sub test()

Dim Array1 As Variant
Dim Array2 As Variant
Dim Array3 As Variant
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim Xfer() As Variant

Set sht1 = ThisWorkbook.Sheets("sheet1")
Set sht2 = ThisWorkbook.Sheets("sheet2")
Set sht3 = ThisWorkbook.Sheets("sheet3")

Array1 = sht1.Range("A1").CurrentRegion
Array2 = sht2.Range("A1").CurrentRegion

cols = UBound(Array1, 2) 'Assumes all arrays are same width
ReDim Xfer(1 To 1, 1 To cols)

a1rows = UBound(Array1, 1)
a2rows = UBound(Array2, 1)


For i = 1 To a1rows
For j = 1 To cols
Xfer(1, j) = Array1(i, j)
Next j
xc1.Add Xfer, "1." & CStr(i)
Next i

For i = 1 To a2rows
For j = 1 To cols
Xfer(1, j) = Array2(i, j)
Next j
xc2.Add Xfer, "2." & CStr(i)
Next i

Call MixMatch

ReDim Array3(1 To xc3.Count, 1 To cols)
For i = 1 To xc3.Count
For j = 1 To cols
Array3(i, j) = xc3(i)(1, j)
Next j
Next i
sht3.Range("A1").CurrentRegion.ClearContents

Set WriteRange = sht3.Range("A1").Resize(xc3.Count, cols)
WriteRange.Value = Array3

End Sub

Sub MixMatch()
Dim ItemsSame As Boolean
Dim RowsSame() As Boolean
Dim match() As Boolean

ReDim RowsSame(1 To 2, 1 To
Application.WorksheetFunction.Max(xc1.Count, xc2.Count))

For i = 1 To xc1.Count
For j = 1 To xc2.Count
ItemsSame = False
For k = 1 To cols
If xc1.Item(i)(1, k) = xc2(j)(1, k) Then
ItemsSame = True
Else
ItemsSame = False
End If
Next k
If ItemsSame Then
RowsSame(1, i) = ItemsSame
RowsSame(2, j) = ItemsSame
End If
Next j
Next i

For i = 1 To xc1.Count
If RowsSame(1, i) = False Then xc3.Add xc1.Item(i)
Next i
For i = 1 To xc2.Count
If RowsSame(2, i) = False Then xc3.Add xc2.Item(i)
Next i
End Sub





"Brian Madsen" wrote in message
ink.net...

"Brian Madsen" wrote in message
ink.net...
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.



Sheet 1 Sheet 2
Sheet3


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

g

(Whoops, looks like I'm also in need of a formatting tutor)
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





Brian Madsen

Matching rows for differences
 
Alex, You are the man!!!!!! I'll play with it for a while and check out
all the variables, but so far it works beautifully. You have saved me so
much time! If you were local, I'd owe you a beer!!!!!!! IF you were a
woman and I were single, I'd marry you.




"Alex J" wrote in message
...
Try This ( I have tested, but I'm not positive it will be logically

correct
for every possible case)
AlexJ

Dim xc1 As New Collection
Dim xc2 As New Collection
Dim xc3 As New Collection
Dim cols As Long

Sub test()

Dim Array1 As Variant
Dim Array2 As Variant
Dim Array3 As Variant
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim sht3 As Worksheet
Dim Xfer() As Variant

Set sht1 = ThisWorkbook.Sheets("sheet1")
Set sht2 = ThisWorkbook.Sheets("sheet2")
Set sht3 = ThisWorkbook.Sheets("sheet3")

Array1 = sht1.Range("A1").CurrentRegion
Array2 = sht2.Range("A1").CurrentRegion

cols = UBound(Array1, 2) 'Assumes all arrays are same width
ReDim Xfer(1 To 1, 1 To cols)

a1rows = UBound(Array1, 1)
a2rows = UBound(Array2, 1)


For i = 1 To a1rows
For j = 1 To cols
Xfer(1, j) = Array1(i, j)
Next j
xc1.Add Xfer, "1." & CStr(i)
Next i

For i = 1 To a2rows
For j = 1 To cols
Xfer(1, j) = Array2(i, j)
Next j
xc2.Add Xfer, "2." & CStr(i)
Next i

Call MixMatch

ReDim Array3(1 To xc3.Count, 1 To cols)
For i = 1 To xc3.Count
For j = 1 To cols
Array3(i, j) = xc3(i)(1, j)
Next j
Next i
sht3.Range("A1").CurrentRegion.ClearContents

Set WriteRange = sht3.Range("A1").Resize(xc3.Count, cols)
WriteRange.Value = Array3

End Sub

Sub MixMatch()
Dim ItemsSame As Boolean
Dim RowsSame() As Boolean
Dim match() As Boolean

ReDim RowsSame(1 To 2, 1 To
Application.WorksheetFunction.Max(xc1.Count, xc2.Count))

For i = 1 To xc1.Count
For j = 1 To xc2.Count
ItemsSame = False
For k = 1 To cols
If xc1.Item(i)(1, k) = xc2(j)(1, k) Then
ItemsSame = True
Else
ItemsSame = False
End If
Next k
If ItemsSame Then
RowsSame(1, i) = ItemsSame
RowsSame(2, j) = ItemsSame
End If
Next j
Next i

For i = 1 To xc1.Count
If RowsSame(1, i) = False Then xc3.Add xc1.Item(i)
Next i
For i = 1 To xc2.Count
If RowsSame(2, i) = False Then xc3.Add xc2.Item(i)
Next i
End Sub





"Brian Madsen" wrote in message
ink.net...

"Brian Madsen" wrote in message
ink.net...
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.



Sheet 1 Sheet 2
Sheet3


1 2 3 4 1 2 3

4
6 7 8 8
2 3 4 5 2 3 4

5
6 7 8 9
6 7 8 9 6 7 8

8
e f g h
a b c d a b c

d
e f h g
e f g h e f h

g

(Whoops, looks like I'm also in need of a formatting tutor)
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








All times are GMT +1. The time now is 03:06 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com