none
AutoFilter - Selecting, Deleting and general working with filtered cells RRS feed

  • Question

  • Just when you think you've got something figured out, VBA throws you for a loop. I have a massive macro with multiple parts pulling data and criteria from several different worksheets... I'm stuck trying to get what I thought would be a simple process to work...

    I need to AutoFilter a Table on a worksheet by a specific criteria (strMaxName) and then delete the rows that meet the criteria.. Here's what I've tried but none of it has worked successfully thus far.

    First Attempt:
    
    ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, Criteria1:="=*" & strMaxName & "*"
    Range("A1").CurrentRegion.Select
    Selection.EntireRow.Delete
    If Current Region < 2 Then
    ActiveShet.ListObjects(1).AutoFilter.ShowAllData
    Else
    Selection.EntireRow.Delete
    End If
    
    
    
    Next Attempt:
    
    With ActiveSheet
       .UsedRange
       lngRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
       Set rng = Range("E1", Cells(lngRow, "E"))
       rng.AutoFilter Field:=5, Criteria:="=*" & strMaxName & "*"
       Set rngDelete = rng.SpecialCells(xlCellTypeVisible)
       rng.AutoFilter
       rngDelete.EntireRow.Delete
    

    And a few other variations and tweaks in between. The filter portion works fine, but it's getting the 'selection' of visible or filtered cells and rows that's stopping me cold. I used a similar format to sort this table and copy the data which worked fine..

    'Start with the basic ActiveSheet... Filter by criteria1 ...
    'Copy filtered data to another sheet
    Range("A1").CurrentRegion.Select
    Application.CutCopyMode = False
    Selection.Copy

    I tried a variation of this code to attempt to delete but I need to incorporate a If 'blank' then skip it piece of code.. 

    I hope this makes sense and there is something simple I am missing or putting in the wrong order. Thanks!!


    I'm new, please help. Begging for forgiveness in advance.
    Wednesday, November 16, 2011 1:18 AM

Answers

  • Added with Edit. I was actually posting this while you were posting and your answer is included

     

    Unfortunately you cannot delete ranges with non contiguous rows (where there are hidden rows between the visible rows) and that is the reason for the complexity.

    Also I have found a bug in my original code. If you were to run the code twice, the second time there would be no visible data in the DataBodyRange and it would produce an error. Therfore need to test that there is more than one line (more than just the column headers.)

    Sub DeleteVisibleRows()
      Dim strMaxname As String
      Dim rngColumn As Range
      Dim cel As Range
      Dim arrCellAddress()
      Dim i As Long
     
      strMaxname = "BBB"    'Used for test only
     
      ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, Criteria1:="=*" & strMaxname & "*"
     
      If ActiveSheet.ListObjects(1).AutoFilter.Range _
            .Columns(1).SpecialCells(xlCellTypeVisible) _
            .Cells.Count > 1 Then
           
        With ActiveSheet.ListObjects(1).DataBodyRange
          'Following line sets rngColumn to a single column of visible cells only
          Set rngColumn = .Columns(1).SpecialCells(xlCellTypeVisible)
        End With
       
        'Iterate through rngColumn and save the cell addresses in a array
        For Each cel In rngColumn
          i = i + 1
          ReDim Preserve arrCellAddress(1 To i)   'One based array
          arrCellAddress(i) = cel.Address
        Next cel
       
        'Must delete rows from bottom upwards so start from last element of array
        For i = UBound(arrCellAddress) To 1 Step -1
          Range(arrCellAddress(i)).EntireRow.Delete
        Next i
     
      Else
        MsgBox "Filter does not return any visible rows"
      End If
     
    End Sub

     

    The following is another version that deletes each contiguous group (or area) within the visible data. This version does not require an array to store the addresses and I am sure would run faster. You could delete th Else and MsgBox at the end; they are just there for the purpose of testing.

    Sub DeleteVisibleRows_2()
      'Areas actually change their address when rows are deleted from the top.
      Dim strMaxname As String
      Dim rngColumn As Range
      Dim rngArea As Range
     
      strMaxname = "BBB"    'Used for test only
     
      ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, _
                Criteria1:="=*" & strMaxname & "*"
     
      If ActiveSheet.ListObjects(1).AutoFilter.Range _
            .Columns(1).SpecialCells(xlCellTypeVisible) _
            .Cells.Count > 1 Then
           
        With ActiveSheet.ListObjects(1).DataBodyRange
          'Following line sets rngColumn to a single column of visible cells only
          Set rngColumn = .Columns(1).SpecialCells(xlCellTypeVisible)
        End With
       
        For Each rngArea In rngColumn.Areas
          rngArea.EntireRow.Delete
        Next rngArea
      Else
        MsgBox "Filter does not return any visible rows"
      End If
    End Sub


    Regards, OssieMac
    Wednesday, November 16, 2011 8:14 PM

All replies

  • OK. You want to delete the visible rows from a filtered Table (ListObject). Is this correct? If so then try the following.

    Sub DeleteVisibleRows()
      Dim strMaxname As String
      Dim rngColumn As Range
      Dim cel As Range
      Dim arrCellAddress()
      Dim i As Long
     
      strMaxname = "BBB"    'Used for test only
     
      ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, Criteria1:="=*" & strMaxname & "*"
     
      With ActiveSheet.ListObjects(1).DataBodyRange
        'Following line sets rngColumn to a single column of visible cells only
        Set rngColumn = .Columns(1).SpecialCells(xlCellTypeVisible)
      End With
     
      'Iterate through rngColumn and save the cell addresses in a array
      For Each cel In rngColumn
        i = i + 1
        ReDim Preserve arrCellAddress(1 To i)   'One based array
        arrCellAddress(i) = cel.Address
      Next cel
     
      'Must delete rows from bottom upwards so start from last element of array
      For i = UBound(arrCellAddress) To 1 Step -1
        Range(arrCellAddress(i)).EntireRow.Delete
      Next i
     
    End Sub


    Regards, OssieMac
    Wednesday, November 16, 2011 4:53 AM
  • Wow, that is completely more complicated than it should have to be, not because of your suggestion, but that is the way VBA handles filtered ranges... I will give it a go this morning. I would have thought that if something like filtering, selecting and then copying is so straight forward and simple, why would this be so complicated, oh well... Maybe I will try 'cutting' the cells and pasting them to a 'trash' tab that I will delete at the end of the code, but I will try your suggestion first :)

    Thanks as always OssieMac!


    I'm new, please help. Begging for forgiveness in advance.
    • Edited by JMStumpf Wednesday, November 16, 2011 1:28 PM
    Wednesday, November 16, 2011 1:21 PM
  • Ok, I went with something like this...
    'Do loop for each Associate name
    Do While Sheets(strLookUp).Range("B" & lngLookUpRow).Value <> ""
    Application.ScreenUpdating = False
    strMaxName = Sheets(strLookUp).Range("B" & lngLookUpRow).Value
    
    ' Filter Columns by MaxName
        For lngColumn = 5 To 9
            ActiveSheet.ListObjects(1).Range.AutoFilter Field:=lngColumn, Criteria1:="=*" & strMaxName & "*"
                With ActiveSheet.ListObjects(1).DataBodyRange
                Set rngColumn = .Columns(lngColumn).SpecialCells(xlCellTypeVisible)
                End With
        
                For Each cel In rngColumn
                i = i + 1
                ReDim Preserve arrCellAddress(1 To i)
                arrCellAddress(i) = cel.Address
                Next cel
        
                For i = UBound(arrCellAddress) To 1 Step -1
                Range(arrCellAddress(i)).EntireRow.Delete
                Next i
            ActiveSheet.ListObjects(1).AutoFilter.ShowAllData
        Next lngColumn
    
    lngLookUpRow = lngLookUpRow + 1
    
    Loop
    

    Which works great until there the filter comes up blank and there are no rows to Set to rngColumn.. I need to incorporate a 'skip it if blank' piece of code, but I'm 95% further than I was yesterday. :)
    I'm new, please help. Begging for forgiveness in advance.
    Wednesday, November 16, 2011 8:05 PM
  • Added with Edit. I was actually posting this while you were posting and your answer is included

     

    Unfortunately you cannot delete ranges with non contiguous rows (where there are hidden rows between the visible rows) and that is the reason for the complexity.

    Also I have found a bug in my original code. If you were to run the code twice, the second time there would be no visible data in the DataBodyRange and it would produce an error. Therfore need to test that there is more than one line (more than just the column headers.)

    Sub DeleteVisibleRows()
      Dim strMaxname As String
      Dim rngColumn As Range
      Dim cel As Range
      Dim arrCellAddress()
      Dim i As Long
     
      strMaxname = "BBB"    'Used for test only
     
      ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, Criteria1:="=*" & strMaxname & "*"
     
      If ActiveSheet.ListObjects(1).AutoFilter.Range _
            .Columns(1).SpecialCells(xlCellTypeVisible) _
            .Cells.Count > 1 Then
           
        With ActiveSheet.ListObjects(1).DataBodyRange
          'Following line sets rngColumn to a single column of visible cells only
          Set rngColumn = .Columns(1).SpecialCells(xlCellTypeVisible)
        End With
       
        'Iterate through rngColumn and save the cell addresses in a array
        For Each cel In rngColumn
          i = i + 1
          ReDim Preserve arrCellAddress(1 To i)   'One based array
          arrCellAddress(i) = cel.Address
        Next cel
       
        'Must delete rows from bottom upwards so start from last element of array
        For i = UBound(arrCellAddress) To 1 Step -1
          Range(arrCellAddress(i)).EntireRow.Delete
        Next i
     
      Else
        MsgBox "Filter does not return any visible rows"
      End If
     
    End Sub

     

    The following is another version that deletes each contiguous group (or area) within the visible data. This version does not require an array to store the addresses and I am sure would run faster. You could delete th Else and MsgBox at the end; they are just there for the purpose of testing.

    Sub DeleteVisibleRows_2()
      'Areas actually change their address when rows are deleted from the top.
      Dim strMaxname As String
      Dim rngColumn As Range
      Dim rngArea As Range
     
      strMaxname = "BBB"    'Used for test only
     
      ActiveSheet.ListObjects(1).Range.AutoFilter Field:=5, _
                Criteria1:="=*" & strMaxname & "*"
     
      If ActiveSheet.ListObjects(1).AutoFilter.Range _
            .Columns(1).SpecialCells(xlCellTypeVisible) _
            .Cells.Count > 1 Then
           
        With ActiveSheet.ListObjects(1).DataBodyRange
          'Following line sets rngColumn to a single column of visible cells only
          Set rngColumn = .Columns(1).SpecialCells(xlCellTypeVisible)
        End With
       
        For Each rngArea In rngColumn.Areas
          rngArea.EntireRow.Delete
        Next rngArea
      Else
        MsgBox "Filter does not return any visible rows"
      End If
    End Sub


    Regards, OssieMac
    Wednesday, November 16, 2011 8:14 PM