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

HEzim

New Member
Joined
Mar 4, 2021
Messages
12
Office Version
  1. 365
  2. 2013
  3. 2011
Platform
  1. Windows
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.
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.

Saurabhj

Active Member
Joined
Jun 6, 2020
Messages
414
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Hi,

Check below code:

VBA 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
 
Solution

HEzim

New Member
Joined
Mar 4, 2021
Messages
12
Office Version
  1. 365
  2. 2013
  3. 2011
Platform
  1. Windows
Hi,

Check below code:

VBA 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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,032
Messages
5,639,649
Members
417,102
Latest member
bcselect

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top