Solved

Delete rows based on a column on another sheet

Posted on 2014-12-04
7
133 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
  • 4
  • 3
7 Comments
 
LVL 33

Expert Comment

by:Norie
Comment Utility
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
Comment Utility
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 33

Expert Comment

by:Norie
Comment Utility
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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:swjtx99
Comment Utility
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
Comment Utility
Hi,

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

Thanks,

swjtx99
0
 
LVL 33

Accepted Solution

by:
Norie earned 500 total points
Comment Utility
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
Comment Utility
Hi imnorie,

Thanks, Excellent and very fast.

Regards,

swjtx99
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

762 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

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now