I need to compare two columns in two different sheets and find out the duplicates: compare column C in 'Sheet2' to column E in 'Sheet1'. As a sample I have used only a few but:
Column E in Sheet1 has 2,000 rows of data.
Column C in Sheet2 has ~ 100 rows of data.
Screenshots of sheets: http://postimg.org/image/jtuinkqgz/
Link to sample Excel file.
Option Explicit
Sub CompareColumns()
'---------------------------------------------------------------------------------------------------
This module loops through two columns in Excel and identifies items without a match. The columns can be on different sheets. -----------
'---------------------------------------------------------------------------------------------------
Dim strCol1 As String 'First Column Location
Dim strCol2 As String 'Second Column Location
Dim strColResults As String 'Output Column
Dim strSheetname1 As String 'First sheet name
Dim strSheetname2 As String 'Second sheet name
Dim iListStart As Integer 'Row where List Begins
Dim strTemp As String
Dim i As Integer, j As Integer
Dim iLastRow1 As Integer, iLastRow2 As Integer
'---Edit these variables---'
strSheetname1 = "Sheet1"
strSheetname2 = "Sheet2"
strCol1 = "A"
strCol2 = "C"
'strColResults = "B"
iListStart = 1
'--------------------------'
iLastRow1 = Sheets(strSheetname1).Range(strCol1 & "50000").End(xlUp).Row
iLastRow2 = Sheets(strSheetname2).Range(strCol2 & "50000").End(xlUp).Row
'error check
If iListStart > WorksheetFunction.Min(iLastRow1, iLastRow2) Then
MsgBox ("List not found. Perform logic check on input variables.")
Exit Sub
End If
Sheets(strSheetname1).Range(strCol1 & iListStart & ":" & strCol1 & iLastRow1).Interior.ColorIndex = 0
Sheets(strSheetname2).Range(strCol2 & iListStart & ":" & strCol2 & iLastRow2).Interior.ColorIndex = 0
strTemp = "<<"
If iLastRow2 > iLastRow1 Then 'switch the order
strTemp = strCol1
strCol1 = strCol2
strCol2 = strTemp
strTemp = strSheetname1
strSheetname1 = strSheetname2
strSheetname2 = strTemp
strTemp = ">>"
End If
'Identify unmatched items in long column
For i = iListStart To WorksheetFunction.Max(iLastRow1, iLastRow2)
For j = iListStart To WorksheetFunction.Min(iLastRow1, iLastRow2)
If UCase(Sheets(strSheetname2).Range(strCol2 & j)) = UCase(Sheets(strSheetname1).Range(strCol1 & i)) Then
'Range(strColResults & i) = i & " to " & j
Exit For ' Stops at first match
ElseIf j = WorksheetFunction.Min(iLastRow1, iLastRow2) Then
'Range(strColResults & i) = strTemp
Sheets(strSheetname1).Range(strCol1 & i).Interior.Color = 255
End If
Next j
Next i
'Identify unmatched items in short column
If strTemp = "<<" Then
strTemp = " >>"
Else
strTemp = " <<"
End If
For i = iListStart To WorksheetFunction.Min(iLastRow1, iLastRow2)
For j = iListStart To WorksheetFunction.Max(iLastRow1, iLastRow2)
If UCase(Sheets(strSheetname1).Range(strCol1 & j)) = UCase(Sheets(strSheetname2).Range(strCol2 & i)) Then
Exit For
ElseIf j = WorksheetFunction.Max(iLastRow1, iLastRow2) Then
'Range(strColResults & i) = Range(strColResults & i) & strTemp
Sheets(strSheetname2).Range(strCol2 & i).Interior.Color = 255
End If
Next j
Next i
End Sub
How do I find the duplicates in column C and maybe color out the duplicates of column C of Sheet2 with column E of Sheet1?