Look through a list in one workbook and find a value in another workbook then delete row if found

[HEzim]

Hi everyone I am struggling here with what should be fairly easy.

I have two lists in two sheets in one excel file. (Sheet 1 and Sheet 2 in Workbook A)

Then I have two other excel files with 1 sheet each in them. Sheet 1 Work Book B. Sheet 1 Work Book C.

So Sheet 1 in Workbook A has a list of values in column A. and I need a vba script that can look through column A and find the matching value in Column A of Sheet 1 workbook B and IF Found then delete the row in Sheet 1 WorkBook B.

(Same thing but for Workbook C.) Then I need it to look Column A in Sheet 2 of work Book A and find the matching value in column A Sheet 1 Work Book C. And if it finds the value then delete the row in Workbook C.


I don't know why but I can't get my code to work. Please help.

 

[Saurabhj]

Hi,

Check below code:

Sub compareSheets()

    Dim sourceWB As Workbook
    Dim destWB As Workbook
    Dim totalRowsSource As Integer, totalRowsDest As Integer, totalRowsSource2 As Integer
    
    Application.ScreenUpdating = False
    Set sourceWB = ThisWorkbook
    Set destWB = Workbooks.Open(ThisWorkbook.Path & "\" & "WBB.xlsm")
    
    totalRowsSource = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    totalRowsSource2 = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    totalRowsDest = destWB.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For rowno = 2 To totalRowsSource
        If Not (IsError(Application.VLookup(sourceWB.Sheets("Sheet1").Cells(rowno, 1), destWB.Sheets("Sheet1").Range("A:A"), 1, 0))) Then
                sourceWB.Sheets("Sheet1").Range("A" & rowno).EntireRow.Delete
        End If
    Next
    destWB.Close
    Set destWB = Workbooks.Open(ThisWorkbook.Path & "\" & "WBC.xlsm")
    For rowno = 2 To totalRowsSource2
        If Not (IsError(Application.VLookup(sourceWB.Sheets("Sheet2").Cells(rowno, 1), destWB.Sheets("Sheet1").Range("A:A"), 1, 0))) Then
                sourceWB.Sheets("Sheet2").Range("A" & rowno).EntireRow.Delete
        End If
    Next
    
    destWB.Close
    Application.ScreenUpdating = True
End Sub

 

[HEzim]

Hi,

Check below code:

Sub compareSheets()

    Dim sourceWB As Workbook
    Dim destWB As Workbook
    Dim totalRowsSource As Integer, totalRowsDest As Integer, totalRowsSource2 As Integer
   
    Application.ScreenUpdating = False
    Set sourceWB = ThisWorkbook
    Set destWB = Workbooks.Open(ThisWorkbook.Path & "\" & "WBB.xlsm")
   
    totalRowsSource = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    totalRowsSource2 = ThisWorkbook.Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
    totalRowsDest = destWB.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
   
    For rowno = 2 To totalRowsSource
        If Not (IsError(Application.VLookup(sourceWB.Sheets("Sheet1").Cells(rowno, 1), destWB.Sheets("Sheet1").Range("A:A"), 1, 0))) Then
                sourceWB.Sheets("Sheet1").Range("A" & rowno).EntireRow.Delete
        End If
    Next
    destWB.Close
    Set destWB = Workbooks.Open(ThisWorkbook.Path & "\" & "WBC.xlsm")
    For rowno = 2 To totalRowsSource2
        If Not (IsError(Application.VLookup(sourceWB.Sheets("Sheet2").Cells(rowno, 1), destWB.Sheets("Sheet1").Range("A:A"), 1, 0))) Then
                sourceWB.Sheets("Sheet2").Range("A" & rowno).EntireRow.Delete
        End If
    Next
   
    destWB.Close
    Application.ScreenUpdating = True
End Sub

Thank you

 

[Saurabhj]

Thanks for the feedback.