Keep Top 5 Lines of Filtered Range - Delete the rest

SimonGeoghegan

Board Regular
Joined
Nov 5, 2013
Messages
68
Hi All,

I have the following loop code which filters my data for me. Once filtered, I want to keep the first top 5 rows of information and delete the rest.

Code:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    'Loop to remove risks except for Top 5
    
    x = 1
    
    Do Until x = 52
       
    Hospital = Workbooks("PERSONAL.XLSB").Worksheets("Sheet1").Range("AG" & x).Value
        
    ActiveSheet.Range("$A$4:$Y$4").AutoFilter Field:=2, Criteria1:=Hospital, Operator:=xlFilterValues
    ActiveSheet.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 1).Select
    
    
        If Application.WorksheetFunction.Subtotal(3, Range("A4:A10000")) > 6 Then
        
            Set tbl = ActiveCell.CurrentRegion
            tbl.Offset(5, 0).Resize(tbl.Rows.Count - 1, _
                tbl.Columns.Count).Select
            Range(Selection, Selection.End(xlToRight).End(xlDown)).Select
            Selection.EntireRow.Delete
        
        End If
        
    Range("A4:Y4").AutoFilter
    
    Range("E5").CurrentRegion.Sort Key1:=Range("E4"), _
                                          DataOption1:=xlSortTextAsNumbers, _
                                          Header:=xlYes
                                          [/FONT]
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif]    x = x + 1[/FONT]


The code almost does what I want, in that it filters and deletes but I think there is an issue with the offset because stepping through the code, it seems to change each time (i'm assuming this is because of the previous 5 lines of information that were kept). Can anybody point me in the right direction for amending the code to keep the first 5 rows of filtered data and delete the rest?

Thanks in advance,
Simon
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
You cannot use CurrentRegion on filtered data, try
Code:
   For x = 1 To 52
       
        Hospital = Workbooks("PERSONAL.XLSB").Worksheets("Sheet1").Range("AG" & x).Value
            
        With ActiveSheet
            .Range("$A$4:$Y$4").AutoFilter Field:=2, Criteria1:=Hospital
            .AutoFilter.Range.Offset(6).EntireRow.Delete
        End With
    Next x
    
    Range("A4:Y4").AutoFilter
    
    Range("E5").CurrentRegion.Sort Key1:=Range("E4"), _
                                          DataOption1:=xlSortTextAsNumbers, _
                                          Header:=xlYes
 
Upvote 0
Thanks Fluff. This appears to work for the first filter criteria, however when it moves onto the next (and all other subsequent values), it deletes everything. The filtering code works as expected but the issue arises during the

Code:
[LEFT][COLOR=#333333][FONT=monospace].AutoFilter.Range.Offset(6).EntireRow.Delete[/FONT][/COLOR][/LEFT]
section of the code.
 
Upvote 0
Think i've cracked it. I replaced that piece of code with:

Code:
[FONT=Verdana,Arial,Tahoma,Calibri,Geneva,sans-serif] .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(5, 0).EntireRow.Delete[/FONT]

That seems to do the trick :)
 
Upvote 0
Glad you sorted it & thanks for the feedback
 
Upvote 0
I think I spoke too soon...!

Having ran the code in its entireity - I seem to have a variety of different rows for each filter criteria, sometimes 2, sometimes upwards of 10.

The rest of my code works as expected at least, but looks like its back to the drawing board regarding the original issue :)
 
Upvote 0
OK, how about

EDIT:
Code removed as it was wrong.
 
Last edited:
Upvote 0
Scrub the previous code and try this instead
Code:
    Dim x As Long, i As Long
    Dim Cl As Range
    Dim Hospital As String
    
    For x = 1 To 52
        i = 0
        Hospital = Workbooks("PERSONAL.XLSB").Worksheets("Sheet1").Range("AG" & x).Value
        
        With ActiveSheet
            .Range("$A$4:$Y$4").AutoFilter Field:=2, Criteria1:=Hospital
            For Each Cl In .AutoFilter.Range.Columns(1).SpecialCells(xlVisible)
                i = i + 1
                If i = 6 Then
                    i = Cl.Row - 3
                    Exit For
                End If
            Next Cl
            .AutoFilter.Range.Offset(i).EntireRow.Delete
        End With
    Next x
 
Upvote 0
Glad to help & thanks for the feedback
 
Upvote 0

Forum statistics

Threads
1,213,549
Messages
6,114,261
Members
448,558
Latest member
aivin

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
Back
Top