Comparing two spreadsheets

[Bob Loblaw]

I have spreadsheet 1 with 915 different "item numbers" listed in column A.
I have spreadsheet 2 with 8000 different "item numbers" listed in column A.

Spreadsheet 1 part numbers are dismantled Spreadsheet 2 numbers. Example:

Spreadsheet 1 item number: 123
Spreadsheet 2 item number: ABC, 123

How do I compare the two lists and in Spreadsheet 2 delete the entire row containing data from Spreadsheet 1? Each item number is unique in Spreadsheet 2.

Does this make any sense? I'm so confused I couldn't even figure out a title for what I'm trying to do. Help!

 

[Bob Loblaw]

You sir, are a genius! From what I can see, that worked perfectly. Thank you!

 

[Bob Loblaw]

Hold the presses. I just did a verification and not all of the data was removed correctly. The correct number of rows were removed. However, when I do a search of the numbers that were supposed to be removed, some are there and some are not.

 

[al_b_cnu]

Oops I should have worked from the end of the list & backwards. Try:

Option Explicit

Sub RemoveData()
Dim lPtr As Long
Dim oEntries As Object
Dim rCur As Range
Dim sKey As String, saKey() As String
Dim vData As Variant
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Set oEntries = Nothing
Set oEntries = CreateObject("Scripting.Dictionary")
For Each rCur In Intersect(ws1.Columns("A"), ws1.UsedRange)
    sKey = Trim$(CStr(rCur.Value))
    If sKey <> "" Then
        On Error Resume Next
        oEntries.Add key:=sKey, Item:=rCur.Row
    End If
Next rCur

vData = Intersect(ws2.Columns("A"), ws2.UsedRange).Value
For lPtr = UBound(vData, 1) To 1 Step -1
    saKey = Split("," & CStr(vData(lPtr, 1)), ",")
    If UBound(saKey) > 1 Then
        sKey = Trim$(saKey(2))
        If sKey <> "" Then
            If oEntries.exists(sKey) Then ws2.Rows(lPtr).Delete shift:=xlUp
        End If
    End If
Next lPtr

oEntries.RemoveAll
Set oEntries = Nothing
End Sub

 

[Bob Loblaw]

Alan. You are the MAN!!! Thank you! I did about 20 sample checks and everything looks perfect.

 

[Bob Loblaw]

What should I do if I want to highlight the cell instead of delete the row?

 

[al_b_cnu]

Hi,

Try:

Sub RemoveData()
Dim lPtr As Long
Dim oEntries As Object
Dim rCur As Range
Dim sKey As String, saKey() As String
Dim vData As Variant
Dim ws1 As Worksheet, ws2 As Worksheet

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")

Set oEntries = Nothing
Set oEntries = CreateObject("Scripting.Dictionary")
For Each rCur In Intersect(ws1.Columns("A"), ws1.UsedRange)
    sKey = Trim$(CStr(rCur.Value))
    If sKey <> "" Then
        On Error Resume Next
        oEntries.Add key:=sKey, Item:=rCur.Row
    End If
Next rCur

vData = Intersect(ws2.Columns("A"), ws2.UsedRange).Value
For lPtr = UBound(vData, 1) To 1 Step -1
    saKey = Split("," & CStr(vData(lPtr, 1)), ",")
    If UBound(saKey) > 1 Then
        sKey = Trim$(saKey(2))
        If sKey <> "" Then
            If oEntries.exists(sKey) Then ws2.Rows(lPtr).Interior.Color = vbYellow
        End If
    End If
Next lPtr

oEntries.RemoveAll
Set oEntries = Nothing
End Sub

 

[Bob Loblaw]

Success! You are genius, Thank you!