PDA

View Full Version : Comparing Data From Two Sheets and Find Non-Matching Values



ms.alisha
08-13-2015, 03:55 PM
Hi guys,

I'm relatively new to VBA and I'm currently struggling to create a macro that would compare data from 2 sheets to find non-matching values and copy&paste them into a separate sheet.

So, I have a unit number, type, required temperature and final destination in columns A, B, C & D respectively on one sheet.
I have the same data from the other source on the second sheet. (A, B, C & D columns as well)
What I would ideally want is:
1. Match values in column A from both sheets
2. If value matches, compare corresponding data in columns B,C & D
3. Copy and paste rows with non-matching data into a separate spreadsheet (so they are side by side) and highlight the differences.

When I put it this way, it doesn't look that hard but I don't even know where to start.

If you could maybe point me in the right direction?..

Thanks a lot in advance!

andrew93
08-14-2015, 05:06 PM
Hi and welcome to VBAX!

You don't need a macro to do this but given this is VBAX we will run with that anyway.

In your workbook, paste the following code into the "ThisWorkbook" section in the VBA screen (I presume you know where to access this). Change the sheet names at the top and then run the macro. Please see my notes below.


Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant
Dim LC1 As Long, LC2 As Long, ORow As Long
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long

ORow = 4
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
With .Sheets(MySheet3)
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
For Loop3 = 2 To 4
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
With .Sheets(MySheet3)
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1
Exit For
End If
Next Loop3
Exit For
Else
DoEvents
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This assumes your headings are in row 1 and your data starts in row 2. Please note the 3 constants at the top of the code for the 3 different sheet names - the first two are name of the sheets that contain the lists you want to compare, and the 3rd being a sheet in the same spreadsheet that will contain the output. You will need to change these to your names of the sheets within the workbook. Note I have left the comparison within the same workbook - if you want to move it to another spreadsheet that is easily accomplished, along with any formatting to highlight the differences (try using conditional formats). So if the comparison sheet (#3) doesn't exist, you will need to create it first.

I trust this helps
Andrew

ms.alisha
08-15-2015, 06:14 PM
Hi and welcome to VBAX!

You don't need a macro to do this but given this is VBAX we will run with that anyway.

In your workbook, paste the following code into the "ThisWorkbook" section in the VBA screen (I presume you know where to access this). Change the sheet names at the top and then run the macro. Please see my notes below.


Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant
Dim LC1 As Long, LC2 As Long, ORow As Long
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long

ORow = 4
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
With .Sheets(MySheet3)
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
For Loop3 = 2 To 4
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
With .Sheets(MySheet3)
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1
Exit For
End If
Next Loop3
Exit For
Else
DoEvents
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This assumes your headings are in row 1 and your data starts in row 2. Please note the 3 constants at the top of the code for the 3 different sheet names - the first two are name of the sheets that contain the lists you want to compare, and the 3rd being a sheet in the same spreadsheet that will contain the output. You will need to change these to your names of the sheets within the workbook. Note I have left the comparison within the same workbook - if you want to move it to another spreadsheet that is easily accomplished, along with any formatting to highlight the differences (try using conditional formats). So if the comparison sheet (#3) doesn't exist, you will need to create it first.

I trust this helps
Andrew

Thanks a lot Andrew!

This works almost perfectly except for the part that macro shows identical results along with the mismatched records on the final sheet.
I thought the reason for that might be different formats but I tried changing formats and the result is the same.

To explain to you what I mean, I've attached my workbook with your macro.

Could you please help me on that?

Thanks a lot,
Alisha

ms.alisha
08-15-2015, 06:16 PM
Hi and welcome to VBAX!

You don't need a macro to do this but given this is VBAX we will run with that anyway.

In your workbook, paste the following code into the "ThisWorkbook" section in the VBA screen (I presume you know where to access this). Change the sheet names at the top and then run the macro. Please see my notes below.


Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant
Dim LC1 As Long, LC2 As Long, ORow As Long
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long

ORow = 4
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
With .Sheets(MySheet3)
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then
For Loop3 = 2 To 4
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
With .Sheets(MySheet3)
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1
Exit For
End If
Next Loop3
Exit For
Else
DoEvents
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This assumes your headings are in row 1 and your data starts in row 2. Please note the 3 constants at the top of the code for the 3 different sheet names - the first two are name of the sheets that contain the lists you want to compare, and the 3rd being a sheet in the same spreadsheet that will contain the output. You will need to change these to your names of the sheets within the workbook. Note I have left the comparison within the same workbook - if you want to move it to another spreadsheet that is easily accomplished, along with any formatting to highlight the differences (try using conditional formats). So if the comparison sheet (#3) doesn't exist, you will need to create it first.

I trust this helps
Andrew

Here is the workbook =)14179

andrew93
08-16-2015, 04:00 PM
Hi

The issue is the second set of data has non-numeric temperatures - so the macro is comparing temperature numeric values with temperature text values which are different by their very nature, resulting in apparent anomalies. Note it works in some cases where the text temperature is formatted as a number, or where there is a non-zero value after the decimal place.

Anyway,add this piece of code:


For Loop2 = 2 To LC2
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2


between these lines:

List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
With .Sheets(MySheet3)


so that it look like this:

List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
For Loop2 = 2 To LC2
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2
With .Sheets(MySheet3)


That should fix the issue.
Andrew

ms.alisha
08-16-2015, 08:41 PM
Hi

The issue is the second set of data has non-numeric temperatures - so the macro is comparing temperature numeric values with temperature text values which are different by their very nature, resulting in apparent anomalies. Note it works in some cases where the text temperature is formatted as a number, or where there is a non-zero value after the decimal place.

Anyway,add this piece of code:


For Loop2 = 2 To LC2
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2


between these lines:

List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
With .Sheets(MySheet3)


so that it look like this:

List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
For Loop2 = 2 To LC2
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2
With .Sheets(MySheet3)


That should fix the issue.
Andrew


It works like a charm!
Thanks a lot for your help, Andrew!

There is only one more thing... (if that's not too much - :-) )
Is it possible to highlight items that do not match at all (items themselves, not taking into account temperature, destination etc.). I.e. the ones that are present on the first sheet but are absent on the second, and vice versa.

Again, huge thanks for your help!

andrew93
08-16-2015, 09:36 PM
Hi

This can definitely be done - either via the macro or formula.

If we do this via the macro, I need to know the following. Is each unit number only shown once on each sheet? Or can a unit number repeat within a list? In addition, do you have any special formatting already in place before the macro runs?

If you want to do this using formulas, you could introduce a new helper column (E) that uses the match formula to detect if a unit number appears on the other list, e.g. on sheet1 in cell E2:
=NOT(ISERROR(MATCH(A2,Sheet2!$A:$A,0)))
Amend accordingly for the cell E2 on Sheet 2. Doing it this way you could use conditional formatting that uses the value in the column E.

If you would rather this was done in the macro, let me know and please answer the questions above.

Andrew

ms.alisha
08-16-2015, 11:19 PM
Hi

This can definitely be done - either via the macro or formula.

If we do this via the macro, I need to know the following. Is each unit number only shown once on each sheet? Or can a unit number repeat within a list? In addition, do you have any special formatting already in place before the macro runs?

If you want to do this using formulas, you could introduce a new helper column (E) that uses the match formula to detect if a unit number appears on the other list, e.g. on sheet1 in cell E2:
=NOT(ISERROR(MATCH(A2,Sheet2!$A:$A,0)))
Amend accordingly for the cell E2 on Sheet 2. Doing it this way you could use conditional formatting that uses the value in the column E.

If you would rather this was done in the macro, let me know and please answer the questions above.

Andrew


Thank you Andrew

Yes, I'm aware of this formula - in fact, this is the way I'm doing it now but I would ideally want to include it in the macro.
Items in each list are unique, i.e. they don't repeat within a list.

So, my idea for that is, compare those lists side by side, and do either of these:
1) if an item is present in both lists, delete the whole row with this item
OR
2) just highlight those items which are present in one list/sheet but are absent in the other.

As for the formatting, those are all in general format.

I hope it's not too much to ask!

Thanks a lot :-)
Still in my learning stage :-)

andrew93
08-16-2015, 11:39 PM
Hi

I hadn't realised you are learning so I have added some comments to the code so you can see what is happening.

Try the following:

Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant 'arrays to hold values
Dim LC1 As Long, LC2 As Long, ORow As Long 'list counts and output row
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long 'looping variables
Dim ColIndex1 As Long, ColIndex2 As Long 'colour indexes (not needed?)

ORow = 4 'this is used for the output row
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count 'count records in list 1
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value 'store list 1 in array
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
For Loop2 = 2 To LC2 'tidy temperatures stored as text
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2
With .Sheets(MySheet3) 'output headings
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
ColIndex1 = .Sheets(MySheet1).Range("A2").Interior.ColorIndex 'get current colour
ColIndex2 = .Sheets(MySheet2).Range("A2").Interior.ColorIndex
.Sheets(MySheet1).Range("A2:A" & LC1).Interior.Color = vbYellow 'highlight all
.Sheets(MySheet2).Range("A2:A" & LC2).Interior.Color = vbYellow
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then 'list match
'restore previous colours
.Sheets(MySheet1).Range("A" & Loop1).Interior.ColorIndex = ColIndex1
.Sheets(MySheet2).Range("A" & Loop2).Interior.ColorIndex = ColIndex2
For Loop3 = 2 To 4 'check all variables are the same
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
.Sheets(MySheet1).Range("A" & Loop1).Interior.Color = vbRed
.Sheets(MySheet2).Range("A" & Loop2).Interior.Color = vbRed
With .Sheets(MySheet3) 'output anomalies
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1 'advance output row
Exit For
End If
Next Loop3
Exit For
Else
DoEvents 'don't hog all resources
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This highlights any orphaned values in yellow. Any mismatched items are highlighted in red (these are the items on Sheet 3).

If you don't want the red highlights, just delete those 2 rows from the code (look for the 2 lines that contain vbRed). With the latest versions of Excel you can filter based on a cell's colour - that might be handy for auditing the results. I prefer to do it this way for integrity purposes - if we delete the data you won't have any audit trail, whereas using filters is easy and handy.

Just ask if you have any questions. I trust this helps.

Andrew

ms.alisha
08-17-2015, 08:01 PM
Hi

I hadn't realised you are learning so I have added some comments to the code so you can see what is happening.

Try the following:

Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant 'arrays to hold values
Dim LC1 As Long, LC2 As Long, ORow As Long 'list counts and output row
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long 'looping variables
Dim ColIndex1 As Long, ColIndex2 As Long 'colour indexes (not needed?)

ORow = 4 'this is used for the output row
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count 'count records in list 1
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value 'store list 1 in array
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
For Loop2 = 2 To LC2 'tidy temperatures stored as text
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2
With .Sheets(MySheet3) 'output headings
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
ColIndex1 = .Sheets(MySheet1).Range("A2").Interior.ColorIndex 'get current colour
ColIndex2 = .Sheets(MySheet2).Range("A2").Interior.ColorIndex
.Sheets(MySheet1).Range("A2:A" & LC1).Interior.Color = vbYellow 'highlight all
.Sheets(MySheet2).Range("A2:A" & LC2).Interior.Color = vbYellow
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then 'list match
'restore previous colours
.Sheets(MySheet1).Range("A" & Loop1).Interior.ColorIndex = ColIndex1
.Sheets(MySheet2).Range("A" & Loop2).Interior.ColorIndex = ColIndex2
For Loop3 = 2 To 4 'check all variables are the same
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
.Sheets(MySheet1).Range("A" & Loop1).Interior.Color = vbRed
.Sheets(MySheet2).Range("A" & Loop2).Interior.Color = vbRed
With .Sheets(MySheet3) 'output anomalies
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1 'advance output row
Exit For
End If
Next Loop3
Exit For
Else
DoEvents 'don't hog all resources
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This highlights any orphaned values in yellow. Any mismatched items are highlighted in red (these are the items on Sheet 3).

If you don't want the red highlights, just delete those 2 rows from the code (look for the 2 lines that contain vbRed). With the latest versions of Excel you can filter based on a cell's colour - that might be handy for auditing the results. I prefer to do it this way for integrity purposes - if we delete the data you won't have any audit trail, whereas using filters is easy and handy.

Just ask if you have any questions. I trust this helps.

Andrew


Thank you very much, Andrew! (and for the comments, too!)
It works perfectly well.
It's now a lot easier for me to understand the whole process - so the next time I can (hopefully) do it myself from scratch :)

Thanks a lot

Regards,
Alisha

ms.alisha
08-19-2015, 04:11 PM
Hi

I hadn't realised you are learning so I have added some comments to the code so you can see what is happening.

Try the following:

Option Explicit

Const MySheet1 As String = "Sheet1" 'list 1
Const MySheet2 As String = "Sheet2" 'list 2
Const MySheet3 As String = "Sheet3" 'output sheet

Sub CompareLists()

Dim List1() As Variant, List2() As Variant 'arrays to hold values
Dim LC1 As Long, LC2 As Long, ORow As Long 'list counts and output row
Dim Loop1 As Long, Loop2 As Long, Loop3 As Long 'looping variables
Dim ColIndex1 As Long, ColIndex2 As Long 'colour indexes (not needed?)

ORow = 4 'this is used for the output row
With ThisWorkbook
LC1 = .Sheets(MySheet1).UsedRange.Rows.Count 'count records in list 1
LC2 = .Sheets(MySheet2).UsedRange.Rows.Count
List1 = .Sheets(MySheet1).Range("A1:D" & LC1).Value 'store list 1 in array
List2 = .Sheets(MySheet2).Range("A1:D" & LC1).Value
For Loop2 = 2 To LC2 'tidy temperatures stored as text
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Trim(List2(Loop2, 3))
End If
If Len(List2(Loop2, 3)) > 0 Then
List2(Loop2, 3) = Val(List2(Loop2, 3))
End If
Next Loop2
With .Sheets(MySheet3) 'output headings
.Cells.ClearContents
.Range("A1").Value = "Mismatched Records"
.Range("A3").Value = "Unit Number"
.Range("B2").Value = MySheet1
.Range("E2").Value = MySheet2
.Range("B3").Value = "Type"
.Range("C3").Value = "Required Temperature"
.Range("D3").Value = "Final Destination"
.Range("E3").Value = "Type"
.Range("F3").Value = "Required Temperature"
.Range("G3").Value = "Final Destination"
End With
ColIndex1 = .Sheets(MySheet1).Range("A2").Interior.ColorIndex 'get current colour
ColIndex2 = .Sheets(MySheet2).Range("A2").Interior.ColorIndex
.Sheets(MySheet1).Range("A2:A" & LC1).Interior.Color = vbYellow 'highlight all
.Sheets(MySheet2).Range("A2:A" & LC2).Interior.Color = vbYellow
For Loop1 = 2 To LC1
For Loop2 = 2 To LC2
If Trim(List1(Loop1, 1)) = Trim(List2(Loop2, 1)) Then 'list match
'restore previous colours
.Sheets(MySheet1).Range("A" & Loop1).Interior.ColorIndex = ColIndex1
.Sheets(MySheet2).Range("A" & Loop2).Interior.ColorIndex = ColIndex2
For Loop3 = 2 To 4 'check all variables are the same
If Trim(List1(Loop1, Loop3)) <> Trim(List2(Loop2, Loop3)) Then
.Sheets(MySheet1).Range("A" & Loop1).Interior.Color = vbRed
.Sheets(MySheet2).Range("A" & Loop2).Interior.Color = vbRed
With .Sheets(MySheet3) 'output anomalies
.Range("A" & ORow).Value = List1(Loop1, 1)
.Range("B" & ORow).Value = List1(Loop1, 2)
.Range("C" & ORow).Value = List1(Loop1, 3)
.Range("D" & ORow).Value = List1(Loop1, 4)
.Range("E" & ORow).Value = List2(Loop2, 2)
.Range("F" & ORow).Value = List2(Loop2, 3)
.Range("G" & ORow).Value = List2(Loop2, 4)
End With
ORow = ORow + 1 'advance output row
Exit For
End If
Next Loop3
Exit For
Else
DoEvents 'don't hog all resources
End If
Next Loop2
Next Loop1
End With

MsgBox "Finished", vbInformation, "Done!"

End Sub

This highlights any orphaned values in yellow. Any mismatched items are highlighted in red (these are the items on Sheet 3).

If you don't want the red highlights, just delete those 2 rows from the code (look for the 2 lines that contain vbRed). With the latest versions of Excel you can filter based on a cell's colour - that might be handy for auditing the results. I prefer to do it this way for integrity purposes - if we delete the data you won't have any audit trail, whereas using filters is easy and handy.

Just ask if you have any questions. I trust this helps.

Andrew


Hi Andrew,

Sorry for bothering you again but I came across a new problem when testing this code.

I tested it on one list and it worked perfectly well but now when I'm trying to do another comparison it returns the "Subscript out of range error".

Any idea why this might be happening?

Any help will be much appreciated :-)

Thanks,
Alisha

ms.alisha
08-19-2015, 08:08 PM
Nevermind :)

I found the error - LC1 should be LC2 in the second case.

But now, when I'm trying to compare my sheets, there's no list of mismatches at all for some reason... Although, there are couple of differences in both sheets.

Am trying to figure out what the problem is but no luck so far :-(

andrew93
08-23-2015, 04:15 PM
Can you attach the sheet? Often a subscript out of range error occurs when either a sheet name is changed/missing or when the code tries to access part of an array that doesn't exist. Also, I'm not sure about changing LC1 to LC2 from my original code so it would be good to see what you have done. Are you copying the code or re-typing it?