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