PDA

View Full Version : Compare values between 2 tables



Michael1974
03-31-2015, 06:21 AM
Hello,

I have a spreadsheet where there are 2 tables in sheet 1. Each table has 4 columns. What I am trying to do is to compare the values between the 2 tables and any unmatched values must be copied and pasted in another sheet (sheet 2).

Does anyone have any suggestion? If my question is not clear. Please let me know.

Thanks

Michael

Yongle
03-31-2015, 08:52 AM
Hi Michael
Neither of your 2 previous threads has been marked as "Solved".
Given the amount of effort that went into them it would be satisfying to see them "Solved".

thanks

Links:
How to compare data in a spreadsheet and paste matched values in another sheet (http://www.vbaexpress.com/forum/showthread.php?52104-How-to-compare-data-in-a-spreadsheet-and-paste-matched-values-in-another-sheet&p=322213&highlight=#post322213)
VLookup with VBA (http://www.vbaexpress.com/forum/showthread.php?52124-VLookup-with-VBA)

From the forum FAQ:

How do I mark a thread as Solved, and why should I?

If your problem has been solved in your thread, mark the thread "Solved" by going to the "Thread Tools" dropdown at the top of the thread. You might also consider rating the thread by going to the "Rate Thread" dropdown which is next to the "Thread Tools" dropdown.

This lets future site visitors with the same problem know that the thread contains a solution. It also rewards the volunteer(s) who helped you solve your problem. Remember that the forum is filled with unpaid volunteers helping you with your problem -- marking your thread as solved and/or rating it is the payment for their help.

Michael1974
03-31-2015, 09:45 AM
Yongle,

I am sorry about this. I just forgot. I will go ahead put them as resolved. Where do I have to go for this?

Michael1974
03-31-2015, 09:54 AM
Hi Yongle. I went back and put them as Solved. Sorry about the delay and thanks for the help on the previous 2 threads. Can you please help me on the new one?

Yongle
03-31-2015, 10:25 AM
Thanks
There are 4 columns in each table that need to match, but what constitutes a match?

Q1 - In which 2 ranges of columns in sheet1 are the items that require matching
(what are the column numbers?)
Q2 - Are the matched entries on the same row as each other? Or are they in different areas of the sheet?
Q3 - Does the whole row need to match OR just one column
ie ColA1 = ColA2 and ColB1 = ColB2 and ColC1 = ColC2 and ColD1 = ColD2 OR ColA1 = ColA2
Q4 - how many rows are there?
<100
1000-10000
10000+

Michael1974
03-31-2015, 10:31 AM
Please see below a shorter version of the 2 tables in question


Table # 1


UniqueID Item # OnHand Location
000050836-S1D01B 000050836 6 S1D01B
000792113-S1A01C 000792113 7 S1A01C
000800259-S1B03B 000800259 69 S1B03B
001455371-S1H01A 001455371 3 S1H01A
002211885-S1D03A 002211885 1 S1D03A
002919215-S1C02C 002919215 7 S1C02C
004145226-S1C04A 003638200 0 S2E02B
004618416-S2A02A 004145226 4 S1C04A


Table # 2



Unique ID
Item #
OnHand
Location


000050836-S1D01B
000050836
6
S1D01B


000792113-S1A01C
000792113
7
S1A01C


000800259-S1B03B
000800259
69
S1B03B


001455371-S1H01A
001455371
3
S1H01A


002211885-S1D03A
002211885
1
S1D03A


002919215-S1C02C
002919215
7
S1C02C


004145226-S1C04A
003638200
0
S2E02B


004618416-S2A02A
004145226
4
S1C04A


004993553-S1A06B
004618416
5
S2A02A

Michael1974
03-31-2015, 10:40 AM
Basically, the goal is to compare to see if the UniqueID # in Table # 1 matches with the one in Table # 2, the same thing applies for Item #, OnHand and location.

The info in Table # 1 must match the one in Table # 2. Any value or cell in Table # 2 that does not match with the ones in Table # 1, will have to be copied and pasted in another sheet (like sheet2 since both tables are on sheet 1). The matched values are supposed to be on the same rows. We have a total 374 rows. Please let me know if I omit to answer any of your questions.

Yongle
04-01-2015, 07:22 AM
What the code does
It looks at the 2 tables and looks for an exact match across the entire row between Table1 and Table2
VBA function Union builds up ranges of matched and unmatched cells
It then copies the
- unmatched entries to sheet PasteUnMatched
- matched rows to PasteMatched
I suspect that this is not going to tell you everything that you need - but we can add a few more features if the basic mechanics are correct.

What you need to do before running the code
1) amend columns B & C
You did not tell me which columns your tables were in - so you will need to amend 2 lines. Col1 needs to be the FIRST column of table1 and Col2 needs to be the FIRST column of table2.
Col1 = ws1.Columns("B").Column
Col2 = ws1.Columns("C").Column
2) create 3 worksheets named
CopyFrom
PasteUnMatched
PasteMatched
3) copy your data into sheet CopyFrom

you said that:

The matched values are supposed to be on the same rows.
So the matching asks - do the 4 cells in Table1row10 match ALL the 4 cells in Table2row10?
If they are not on the same rows then this coding will not work and then we need to use a different lookup method - probably index and match


Sub CopyMatchedEntries()
'declare variables
Dim Col1 As Long, Col2 As Long, LastRow As Long
Dim i As Integer
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim Matched As Range, Notmatched As Range
'set ranges
Set ws1 = Worksheets("CopyFrom")
Set ws2 = Worksheets("PasteUnMatched")
Set ws3 = Worksheets("PasteMatched")
Set Matched = ws1.Rows("1048576")
Set Notmatched = ws1.Rows("1048576")
'first column of each table
Col1 = ws1.Columns("B").Column
Col2 = ws1.Columns("C").Column
'last row of table1
LastRow = ws1.Cells(2, Col1).End(xlDown).Row
'check for matching values
For i = 2 To LastRow
If ws1.Cells(i, Col1).Value = ws1.Cells(i, Col2).Value Then
If ws1.Cells(i, Col1 + 1).Value = ws1.Cells(i, Col2 + 1).Value Then
If ws1.Cells(i, Col1 + 2).Value = ws1.Cells(i, Col2 + 2).Value Then
If ws1.Cells(i, Col1 + 3).Value = ws1.Cells(i, Col2 + 3).Value Then
Set Matched = Union(Matched, ws1.Rows(i))
End If
Else
Set Notmatched = Union(Notmatched, ws1.Rows(i))
End If
End If
End If
Next i
'copy the matched rows
Matched.Copy
ws3.Range("A2").PasteSpecial xlPasteAll
'copy not matched rows
Notmatched.Copy
ws2.Range("A2").PasteSpecial xlPasteAll
End Sub

Yongle
04-02-2015, 06:14 AM
Another option for you
I was working on something for someone else, and made to think differently because there were over 10000 rows in his worksheets, and the line by line checking became unbearably slow. This uses the Excel "Remove Duplicates" facility
What the code does
Although this code seems very long, it is because I adapted something a bit more complicated and did not have time to hone it down. Also with the number of records you have, the sorting becomes unnecessary - it will not save time. So you could delete all the sorts, which will cut the code down significantly.
- the macro copies the data from SheetA into SheetC, and then from SheetB into SheetC
- t is sorted (not really necessary)
- Excel "Remove Duplicates" applied in SheetC
At the moment it is based on just looking at column A, but you could amend it to look at more columns or the complete row for a match. You need to replace one line. (see the comments in blue)
- then looks for items that do not match putting SheetA non-matches into SheetD and SheetB non-matches into SheetE
Headings etc have been ignored - you can add those when you are happy that the code is doing what you want.

What you need to do
- Use the attached workbook
- Copy one block of data into SheetA
- Copy the other block of data into SheetB
(Headings need to go in Row1 on both sheets)
(Data needs to start at Row2 on both sheets)
- run the macro
You will need to clear the contents of Sheets C, D & E before you run it each time - or you can add a line at the beginning of the macro to do it for you. (cells.clear is one option)



Sub Dup_2Tables()
'declare variables
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet, wsE As Worksheet
Dim LastRowA As Long, lastRowB As Long, LastRowC As Long
Dim LastColA As Long, LastColB As Long
Dim DataA As Range, DataB As Range, DataC As Range
Dim NotMatchedA As Range, NotMatchedB As Range
Dim i As Integer
'set ranges
Set wsA = Worksheets("SheetA")
Set wsB = Worksheets("SheetB")
Set wsC = Worksheets("SheetC")
Set wsD = Worksheets("SheetD")
Set wsE = Worksheets("SheetE")
LastRowA = wsA.Range("A1048576").End(xlUp).Row
lastRowB = wsB.Range("A1048576").End(xlUp).Row
LastColA = wsA.Range("A1").End(xlToRight).Column
LastColB = wsB.Range("A1").End(xlToRight).Column
Set DataA = wsA.Cells(2, 1).Resize(LastRowA - 1, LastColA)
Set DataB = wsB.Cells(2, 1).Resize(lastRowB - 1, LastColB)


'sort the data in SheetA
With wsA
wsA.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & LastRowA), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B2:B" & LastRowA), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("D2:D" & LastRowA), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With wsA.Sort
.SetRange Range("A2:D" & LastRowA)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
End With


'sort the data in SheetB
With wsB
wsB.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & lastRowB), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B2:B" & lastRowB), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("D2:D" & lastRowB), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With wsB.Sort
.SetRange Range("A2:D" & lastRowB)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
End With


'copy the data to SheetC
DataA.Copy
wsC.Range("A2").PasteSpecial xlAll
DataB.Copy
wsC.Range("A20000").End(xlUp).Offset(1, 0).PasteSpecial xlAll


'sort the data in SheetC
LastRowC = wsC.Range("A1048576").End(xlUp).Row

With wsC
wsC.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("A2:A" & LastRowC), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("B2:B" & LastRowC), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.Sort.SortFields.Add Key:=Range("D2:D" & LastRowC), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With wsC.Sort
.SetRange Range("A2:D" & LastRowC)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
End With
'remove duplicates in SheetC
Set DataC = wsC.Range("A2:D" & LastRowC)
DataC.RemoveDuplicates Columns:=1, Header:=xlNo ' this is based on colum A only
'------------------------------------------
'NEXT LINE IS AN ELTERNATIVE TO LINE ABOVE
'DataC.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlNo ' this is based on all comumns
'------------------------------------------


'create tabled of unmatched items
LastRowC = wsC.Range("A1048576").End(xlUp).Row

'SHEETD includes those items from sheetA that do not match
For i = LastRowC To 2 Step -1
Set NotMatchedA = wsC.Range("A1048576")
If IsError(Application.Match(wsC.Cells(i, 1).Value, wsA.Range("A2:A" & LastRowA).Value, 0)) Then
wsC.Rows(i).Copy
wsD.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
Next i

'SHEETE includes those items from sheetB that do not match
For i = LastRowC To 2 Step -1
Set NotMatchedB = wsC.Range("A1048576")
If IsError(Application.Match(wsC.Cells(i, 1).Value, wsB.Range("A2:A" & lastRowB).Value, 0)) Then
wsC.Rows(i).Copy
wsE.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
End If
Next i




End Sub