Results 1 to 10 of 10

Thread: Keep Top 5 Lines of Filtered Range - Delete the rest
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    New Member
    Join Date
    Nov 2013
    Location
    Manchester
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Keep Top 5 Lines of Filtered Range - Delete the rest

    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:
        '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
                                              
        x = x + 1

    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

  2. #2
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,246
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  3. #3
    New Member
    Join Date
    Nov 2013
    Location
    Manchester
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    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:
    .AutoFilter.Range.Offset(6).EntireRow.Delete
    section of the code.

  4. #4
    New Member
    Join Date
    Nov 2013
    Location
    Manchester
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    Think i've cracked it. I replaced that piece of code with:

    Code:
     .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Offset(5, 0).EntireRow.Delete
    That seems to do the trick

  5. #5
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,246
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    Glad you sorted it & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  6. #6
    New Member
    Join Date
    Nov 2013
    Location
    Manchester
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    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

  7. #7
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,246
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    OK, how about

    EDIT:
    Code removed as it was wrong.
    Last edited by Fluff; Oct 14th, 2019 at 03:12 PM.
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  8. #8
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,246
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    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
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

  9. #9
    New Member
    Join Date
    Nov 2013
    Location
    Manchester
    Posts
    37
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    Hi Fluff,

    Thanks for this - that works perfectly. Apologies for the delay, I was out of the office!

    Thanks,
    Simon

  10. #10
    MrExcel MVP
    Moderator
    Fluff's Avatar
    Join Date
    Jun 2014
    Location
    Chippenham
    Posts
    29,246
    Post Thanks / Like
    Mentioned
    483 Post(s)
    Tagged
    49 Thread(s)

    Default Re: Keep Top 5 Lines of Filtered Range - Delete the rest

    Glad to help & thanks for the feedback
    - Posting Data try one of these tools
    - Posting guidelines, forum rules and terms of use
    - Read the FAQs

    Running Office 365 on Win 10

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •