VBA Excel remove Items unique to one sheet - excel

Question

I'm working on a long application and I hit a wall trying to find unique records between 2 sheets and removing the row from the first sheet if the record doesn't exist in the second sheet. Here's the code I have for this section of my program, I'm a bit confuse as to how to accomplish this and I'm hoping someone will be willing to take a look and give me some suggestions, thanks.
*Explanation:
I'm looking for the unique records in column B and I'll be searching over 3000 cells in that column. If the records exist in sheet 1 but not in sheet 2 they should be deleted.
Option Explicit
Sub RemoveReversionItems()
Dim wbook As Workbook, Wsheet As Worksheet, wbName As String, wsName As String
Dim AlphaRange As Range, ReversionRange As Range
Dim AlphaArray
Dim ReversionArray
Dim x As Long
Dim AlphaSheetColumn As String: AlphaSheetColumn = "B" 'The column with the PO#
Dim ReversionSheetColumn As String: ReversionSheetColumn = "B" 'The column with the PO#
For Each wbook In Workbooks
If wbook.Name <> ActiveWorkbook.Name Then wbName = wbook.Name
Workbooks(wbName).Activate
'********************************
' Look for Reversion Queue
'********************************
For Each Wsheet In wbook.Worksheets
wsName = Wsheet.Name
If Wsheet.Name Like "Revers*" Then
MsgBox "This workbook is named " & wbName & " The Sheet is " & wsName
'Get Reversion Range
With Sheets(wsName)
Set ReversionRange = .Range(.Range(ReversionSheetColumn & "2"), _
.Range(ReversionSheetColumn & rows.Count).End(xlUp))
ReversionArray = ReversionRange
End With
End If
Next Wsheet
'*****************************
' Look for Alpha Queue
'*****************************
For Each Wsheet In wbook.Worksheets
wsName = Wsheet.Name
If Wsheet.Name Like "PO_LN*" Then
'Load Alpha WorkSheet array
With Sheets(wsName)
Set AlphaRange = .Range(.Range(AlphaSheetColumn & "2"), _
.Range(AlphaSheetColumn & rows.Count).End(xlUp))
AlphaArray = AlphaRange
End With
MsgBox "This workbook is named " & wbName & " The Sheet is " & wsName
End If
Next Wsheet
If IsArray(ReversionArray) Then
For x = UBound(ReversionArray) To 1 Step -1
If AlphaArray <> ReversionArray(x, 2) Then
ReversionRange.Cells(x).EntireRow.Interior.Color = 255 'Newtest
End If
Next
Else
End If
Next wbook
End Sub

Answer 1

This function compares 2 data sheets with the same columns based on a primary key. It will highlight non-matched rows in orange and where the rows do match it will find any differences in the field values and highlight red and create a comment to show mismatched value (you can always removed this functionality)
Just pass in the 2 sheet names, the primary key col and whether data has col headers.
eg. strResult=CompareDataSheets("Sheet1","Sheet2",1,True)
Function CompareDataSheets(ByVal sht1 As String, ByVal sht2 As String, ByVal pkCol As Integer, ByVal hasHeaders As Boolean) As String
Dim ws1, ws2 As Worksheet
Dim x As Integer
Dim nmSht1, nmSht2, colDiffs, colName As String
Dim strIdentifier As String
Dim vmatch As Variant
Set ws1 = ActiveWorkbook.Sheets(sht1)
Set ws2 = ActiveWorkbook.Sheets(sht2)
On Error GoTo Err
If hasHeaders Then x = 2 Else x = 1
'Find Non Matches in sheet1
Do Until ws1.Cells(x, pkCol).Value = ""
vmatch = Application.Match(ws1.Cells(x, pkCol).Value, ws2.Columns(pkCol), 0)
If IsError(vmatch) Then
ws1.Rows(x).Interior.Color = 49407
Else
'Find Matched PK Column diffs
iCol = 1
Do Until ws1.Cells(1, iCol).Value = ""
If ws1.Cells(x, iCol).Value <> ws2.Cells(x, iCol).Value Then
If hasHeaders Then
colName = ws1.Cells(1, iCol).Value
Else
colName = iCol
End If
With ws1.Cells(x, iCol)
.Interior.Color = 5263615
.ClearComments
.AddComment sht2 & " Value=" & ws2.Cells(x, iCol).Value
End With
If ws2.Cells(x, iCol).Value <> "" Then
With ws2.Cells(x, iCol)
.Interior.Color = 5263615
.ClearComments
.AddComment sht1 & " Value=" & ws1.Cells(x, iCol).Value
End With
End If
End If
iCol = iCol + 1
Loop
End If
x = x + 1
Loop
If Len(nmSht1) > 0 Then nmSht1 = Left(nmSht1, Len(nmSht1) - 1)
If hasHeaders Then x = 2 Else x = 1
'Find Non Matches in sheet2
Do Until ws2.Cells(x, pkCol).Value = ""
vmatch = Application.Match(ws1.Cells(x, pkCol).Value, ws2.Columns(pkCol), 0)
If IsError(vmatch) Then
ws2.Rows(x).Interior.Color = 49407
End If
x = x + 1
Loop
If Len(nmSht2) > 0 Then nmSht2 = Left(nmSht2, Len(nmSht2) - 1)
CompareDataSheets = "Done!"
Exit Function
Err:
CompareDataSheets = "Error: " & Err.Description
End Function