Sub CompareColumns()
Dim Column1 As Range
Dim Column2 As Range
'Prompt user for the first column range to compare...
'----------------------------------------------------
Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
'Check that the range they have provided consists of only 1 column...
If Column1.Columns.Count > 1 Then
Do Until Column1.Columns.Count = 1
MsgBox "You can only select 1 column"
Set Column1 = Application.InputBox("Select First Column to Compare", Type:=8)
Loop
End If
'Prompt user for the second column range to compare...
'----------------------------------------------------
Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
'Check that the range they have provided consists of only 1 column...
If Column2.Columns.Count > 1 Then
Do Until Column2.Columns.Count = 1
MsgBox "You can only select 1 column"
Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
Loop
End If
'Check both column ranges are the same size...
'---------------------------------------------
If Column2.Rows.Count <> Column1.Rows.Count Then
Do Until Column2.Rows.Count = Column1.Rows.Count
MsgBox "The second column must be the same size as the first"
Set Column2 = Application.InputBox("Select Second Column to Compare", Type:=8)
Loop
End If
'If entire columns have been selected (e.g. $AEmbarrassedA), limit the range sizes to the
'UsedRange of the active sheet. This stops the routine checking the entire sheet
'unnecessarily.
'-------------------------------------------------------------------------------
If Column1.Rows.Count = 65536 Then
Set Column1 = Range(Column1.Cells(1), Column1.Cells(ActiveSheet.UsedRange.Rows.Count))
Set Column2 = Range(Column2.Cells(1), Column2.Cells(ActiveSheet.UsedRange.Rows.Count))
End If
'Perform the comparison and set cells that are the same to yellow
'----------------------------------------------------------------
Dim intCell As Long
For intCell = 1 To Column1.Rows.Count
If Column1.Cells(intCell) <> Column2.Cells(intCell) Then
Column1.Cells(intCell).Interior.Color = vbYellow
Column2.Cells(intCell).Interior.Color = vbYellow
Else
Column1.Cells(intCell).Interior.Color = vbWhite
Column2.Cells(intCell).Interior.Color = vbWhite
End If
Next
End Sub