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

Originally Posted by andrew93

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

Originally Posted by andrew93

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 =)DiscrepanciesTest.xlsm

**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

Originally Posted by andrew93

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

Originally Posted by andrew93

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

Originally Posted by andrew93

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

Originally Posted by andrew93

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?

Thread: Comparing Data From Two Sheets and Find Non-Matching Values

Thread Tools

Display

Comparing Data From Two Sheets and Find Non-Matching Values

Code works - almost

Tags for this Thread

Posting Permissions