Solved

Delete rows based on a column on another sheet

Posted on 2014-12-04
7
148 Views
Last Modified: 2014-12-04
Hi,

I need VBA solution to delete any row on Sheet1 where there is no match between column D on Sheet1 and column A on Sheet2.

Data will always be a text string and the number of rows on either sheet will vary.

Example attached.

Thanks in advance,

swjtx99
Example.xlsx
0
Comment
Question by:swjtx99
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 3
7 Comments
 
LVL 34

Expert Comment

by:Norie
ID: 40481292
Perhaps.
Option Explicit

Sub DeleteRows()
Dim rng As Range
Dim rngNames As Range
Dim Res As Variant
Dim I As Long

    With Sheets("Sheet2")
        Set rngNames = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

    For I = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1

        Set rng = Sheets("Sheet1").Range("D" & I)

        Res = Application.Match(rng.Value, rngNames, 0)

        If IsError(Res) Then
            rng.EntireRow.Delete xlShiftUp
        End If

    Next I

End Sub

Open in new window

0
 

Author Comment

by:swjtx99
ID: 40481450
Hi,

Thanks for the reply. This appears to work but I haven't been able to confirm because my sheet is 45000 rows and it's been over 20 minutes and it's still going. Is there a more expedient method?

Thanks,
0
 
LVL 34

Expert Comment

by:Norie
ID: 40481473
You could try disabling events, turning off screen updating and setting calculations to manual while the code runs.
Option Explicit

Sub DeleteRows()
Dim rng As Range
Dim rngNames As Range
Dim Res As Variant
Dim I As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    With Sheets("Sheet2")
        Set rngNames = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

    For I = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1

        Set rng = Sheets("Sheet1").Range("D" & I)

        Res = Application.Match(rng.Value, rngNames, 0)

        If IsError(Res) Then
            rng.EntireRow.Delete xlShiftUp
        End If

    Next I

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
End Sub

Open in new window


Is the data in the attached workbook a 'real' representation of your data?

I ask because there could be other methods to speed things, eg using arrays, but they would be dependent on the actual data.
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:swjtx99
ID: 40481529
Hi,

Yes it is an accurate representation of the format. I have a few more actual "owners" and as stated my actual sheet is 45000 rows and more columns but it's doing the same thing which is comparing owners and if they don't exist, I need to delete the row. I just cut it down to 500 and inserted:

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

and it still took about 30 seconds to run. I have an i7 8GB and nothing else running. Would an array method be faster?

Thanks for your help,

swjtx99
but it still took
0
 

Author Comment

by:swjtx99
ID: 40481539
Hi,

Might help if I mention there are 17 columns, A-Q.

Thanks,

swjtx99
0
 
LVL 34

Accepted Solution

by:
Norie earned 500 total points
ID: 40481589
Strange, I tried the code on approx 45000 rows and it seemed quite speedy.

Anyway, perhaps doing the deletion in one go might help speed things up.
Option Explicit



Sub DeleteRows()
Dim rng As Range
Dim rngNames As Range
Dim rngDel As Range
Dim Res As Variant
Dim I As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    With Sheets("Sheet2")
        Set rngNames = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With

    For I = Sheets("Sheet1").Range("D" & Rows.Count).End(xlUp).Row To 2 Step -1

        Set rng = Sheets("Sheet1").Range("D" & I)

        Res = Application.Match(rng.Value, rngNames, 0)

        If IsError(Res) Then
            If rngDel Is Nothing Then
                Set rngDel = rng.EntireRow
            Else
                Set rngDel = Union(rngDel, rng.EntireRow)
            End If
        End If

    Next I

    If Not rngDel Is Nothing Then
        rngDel.Delete
    End If
    
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    
End Sub

Open in new window

0
 

Author Closing Comment

by:swjtx99
ID: 40481735
Hi imnorie,

Thanks, Excellent and very fast.

Regards,

swjtx99
0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

617 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question