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