What code would I use to delete specific rows in an xlsx spreadsheet?

I have a large excel file with many fields.  I need to delete all rows except those that have a subject ID that begins with

429.  Please see attached sample of the Subject ID field.

What code could I use to accomplish this task. eedeleterows.xlsx Thanks,
BiopsychAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

byundtMechanical EngineerCommented:
Here is a macro that uses the AutoFilter to select rows where ID column does not begin with 429. It then deletes those rows.
Sub IDequals429()
Dim rg As Range, rgFilter As Range, rgFiltered As Range
With Range("A1")    'The header label for ID column
    Set rg = .CurrentRegion
    Set rgFilter = rg.Offset(1).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    .AutoFilter
    rg.AutoFilter Field:=.Column - rg.Column + 1, Criteria1:="<>429*", Operator:=xlAnd
    On Error Resume Next
    Set rgFiltered = rgFilter.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rgFiltered Is Nothing Then rgFiltered.EntireRow.Delete
    .AutoFilter
End With
End Sub

Open in new window


If you have a large number of rows of data, you may find this approach either takes too long or it deletes all the rows of data. Please advise, as there are workarounds for this "feature" of the SpecialCells method.
eedeleterowsQ28736223.xlsm
0
byundtMechanical EngineerCommented:
Here is the workaround for large numbers of rows where the SpecialCells method results in too many areas (Excel 2007 and earlier returns everything if there are more than 8192 non-contiguous blocks of cells in the filtered range):
Sub AltID429()
Dim rg As Range, rgFilter As Range, rgFiltered As Range, rgTest As Range
Application.ScreenUpdating = False
With Range("A1")    'The header label for ID column
    Set rg = .CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count, rg.Columns.Count + 1)
    Set rgFilter = rg.Offset(1).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    Set rgTest = rgFilter.Columns(rgFilter.Columns.Count)
    rgTest.FormulaR1C1 = "=LEFT(RC" & .Column & ",3)=""429"""
    With .Worksheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=rgTest, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange rg
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    rg.AutoFilter Field:=rgTest.Column - rg.Column + 1, Criteria1:="False"
    
    On Error Resume Next
    Set rgFiltered = rgFilter.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rgFiltered Is Nothing Then rgFiltered.EntireRow.Delete
    rg.AutoFilter
    rgTest.EntireColumn.Delete
End With
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
BiopsychAuthor Commented:
Byundt,

Thanks for the code. Will test as soon as I can and let you know.
0
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

BiopsychAuthor Commented:
Just tested your code.

In the real file that contains many more IDs and additional columns I get a Microsoft  400 error.

When I tried your code in the sample file I sent, the code stops at  "Autofilter"
I assume it worked when you tested on the sample.
What do suggest?
0
BiopsychAuthor Commented:
Excellent solution. Thank you
0
BiopsychAuthor Commented:
BTW -  Worked perfectly in Windows 7. Thank you very much.  The issues I described were on my iMAC.

The workbook I have has about 20 sheets and I need your code to run on all 20 sheets.
What do you suggest?
0
byundtMechanical EngineerCommented:
I left out two letters in statement 28 in the Answer. This may explain your problem on the iMac. It should have read:
rg.AutoFilter

Acting as Topic Advisor, I corrected the code in that Comment.

To loop through all 20 worksheets, I changed AltID429 to use an optional parameter of a worksheet. I then called that sub in a loop that went through every worksheet in a workbook, with specified exceptions.
Sub LoopThroughWorksheets()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    Select Case ws.Name
    Case "Master", "Hidden worksheet"   'Don't do anything with these worksheets
    Case Else
        AltID429 ws
    End Select
Next
End Sub

Sub AltID429(Optional ws As Worksheet)
Dim rg As Range, rgFilter As Range, rgFiltered As Range, rgTest As Range
Application.ScreenUpdating = False
If ws Is Nothing Then Set ws = ActiveSheet
With ws.Range("A1")    'The header label for ID column
    Set rg = .CurrentRegion
    Set rg = rg.Resize(rg.Rows.Count, rg.Columns.Count + 1)
    Set rgFilter = rg.Offset(1).Resize(rg.Rows.Count - 1, rg.Columns.Count)
    Set rgTest = rgFilter.Columns(rgFilter.Columns.Count)
    rgTest.FormulaR1C1 = "=LEFT(RC" & .Column & ",3)=""429"""
    With ws
        .Sort.SortFields.Clear
        .Sort.SortFields.Add Key:=rgTest, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With .Sort
            .SetRange rg
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    rg.AutoFilter Field:=rgTest.Column - rg.Column + 1, Criteria1:="False"
    
    On Error Resume Next
    Set rgFiltered = rgFilter.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Not rgFiltered Is Nothing Then rgFiltered.EntireRow.Delete
    rg.AutoFilter
    rgTest.EntireColumn.Delete
End With
End Sub

Open in new window

0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.