Delete hidden rows using VBA and an array?

[LAAdams17]

I have a spreadsheet with thousands of rows. I need to delete the rows that are filtered out. Each solution I've tried so far takes forever to get this done. I'm thinking there may be a much faster way to get this done using VBA and an array (read active worksheet into an array, delete the hidden rows and then write the array back out)? Can anyone help with this? Thank you in advance!

 

[xenou]

VBA Array will not have information about hidden rows unfortunately. But it does help with deleting hidden rows to turn of screen updateing and to turn off calculation, then re-enable these when rows are deleted. I have found that otherwise there is a recalculation every time a row is deleted (and if it is taking more than a few milliseconds to recalculate the sheet or workbook that can become noticeable and even very slow).

Another idea if that doesn't help is to copy the visible cells, then delete all the rows, then copy the visible cells back in (or something along those lines). I believe there is a method for copying visible cells only (and a little known button for it that you can add to your quick access toolbar).

 

[Marc L]

Imagine a day during a presentation of some Excel based inner tool when the VBA code was deleting a huge numbers of rows​

it took ages ! A director became red, not happy but suddenly a summer job kid said​

« I don't understand as operating manually needs no more than a minute ! »​

He was prompted to show his way and he was right and the VBA procedure was still running ‼​

So imagine just reproducing his way under VBA just using Excel basics, at beginner level, one of the two fastest ways I know …​

​

But the question could be « What is the best ? » and in my opinion​

this is the one you are able to maintain yourself depending on your VBA skills …​

​

The Excel basics way to fast delete rows is not to delete them but to clear them as clearing is faster than deleting !​

And without filtering …​

​

The idea is to use a column to mark the rows to keep and the rows to 'delete' with 0 - 1 or FALSE - TRUE whatever …​

It could be a temporary column as a helper one, can use a formula.​

So once this column is filled, the rows just need to be sorted according to this column in an ascending way​

in order all the rows to delete (1 or TRUE) are at the end of the data range so they can be cleared at once !​

Then the helper column can be cleared as well …​

​

 

[Peter_SSs]

You could give this a try with a copy of your data. You should find it pretty fast. ?
I have assumed that your filter header row is row 1.

Sub Del_Rows()
  Dim i As Long, j As Long, k As Long, lr As Long, nc As Long
  Dim Rws As Variant, b As Variant

  With Columns("A").SpecialCells(xlVisible)
    If .Areas.Count > 1 Then
      lr = .Areas(.Areas.Count).Row
      ReDim b(1 To lr, 1 To 1)
      Rws = Split(Range("A1:A" & lr).SpecialCells(xlVisible).Address(0, 0), ",")
      For i = 0 To UBound(Rws) - 1
        For j = Mid(Split(Rws(i) & ":" & Rws(i), ":")(1), 2) + 1 To Mid(Split(Rws(i + 1), ":")(0), 2) - 1
          b(j, 1) = 1
          k = k + 1
        Next j
      Next i
      Application.ScreenUpdating = False
      ActiveSheet.ShowAllData
      nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      With Range("A2").Resize(lr - 1, nc)
        .Columns(nc).Offset(-1).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    Else
      MsgBox "No hidden rows"
    End If
  End With
End Sub

 

[Marc L]

delete the hidden

When using a filter the obvious way is to directly filter the rows to delete rather than the rows to keep …​

Deleting rows from a filter : the more non contiguous rows to delete, the slower …​

With huge data and the more non contiguous rows to delete, my previous post way can be faster than the filter / delete way.​

​

 

[LAAdams17]

Thank you. This exactly what I'm looking for. However, I'm getting an error on the line: .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo

You could give this a try with a copy of your data. You should find it pretty fast. ?
I have assumed that your filter header row is row 1.

Sub Del_Rows()
  Dim i As Long, j As Long, k As Long, lr As Long, nc As Long
  Dim Rws As Variant, b As Variant

  With Columns("A").SpecialCells(xlVisible)
    If .Areas.Count > 1 Then
      lr = .Areas(.Areas.Count).Row
      ReDim b(1 To lr, 1 To 1)
      Rws = Split(Range("A1:A" & lr).SpecialCells(xlVisible).Address(0, 0), ",")
      For i = 0 To UBound(Rws) - 1
        For j = Mid(Split(Rws(i) & ":" & Rws(i), ":")(1), 2) + 1 To Mid(Split(Rws(i + 1), ":")(0), 2) - 1
          b(j, 1) = 1
          k = k + 1
        Next j
      Next i
      Application.ScreenUpdating = False
      ActiveSheet.ShowAllData
      nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
      With Range("A2").Resize(lr - 1, nc)
        .Columns(nc).Offset(-1).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    Else
      MsgBox "No hidden rows"
    End If
  End With
End Sub

 

[Peter_SSs]

What is the full error message?

What Excel version & platform are you using? I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using. (Don’t forget to scroll down & ‘Save’)

 

[Akuini]

Another option:

Sub a1167354b()
Dim r As Range, q As Range

Set q = ActiveSheet.UsedRange.Columns("A").Offset(1)
Set r = q.SpecialCells(xlCellTypeVisible)

Range("A1").AutoFilter
r.EntireRow.Hidden = True
q.SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
q.EntireRow.Hidden = False

End Sub

but after running the code you need to sort the data to remove the blank rows.

@Peter_SSs
this part:
Rws = Split(Range("A1:A" & lr).SpecialCells(xlVisible).Address(0, 0), ",")

I think it only works if the address doesn't exceed 256 characters. So if there are, say hundreds of non-contiguous areas then it won't work correctly.

 

[Peter_SSs]

@LAAdams17
Please disregard my previous code per Akuini's comments about it as it is unlikely to suit your large data.

@Peter_SSs
this part:
Rws = Split(Range("A1:A" & lr).SpecialCells(xlVisible).Address(0, 0), ",")

I think it only works if the address doesn't exceed 256 characters. So if there are, say hundreds of non-contiguous areas then it won't work correctly.

Good point, thanks. (Rookie error only testing with small data. )

New attempt. I have borrowed a little from your code but still trying to include some of the checks/features of my previous code like
- in case there are no rows hidden by the autofilter
- in case used range includes the last row on the sheet which is not unusual
- keeping the remaining rows in their current order
- if say 10,000 rows of data but last hidden row is row 100, avoiding any processing at all (including sorting) of the last 9,900 rows

Sub Del_Rows_v2()
  Dim rVis As Range
  Dim lr As Long, nc As Long
 
  With Columns("A").SpecialCells(xlVisible)
    If .Areas.Count > 1 Then
      lr = .Areas(.Areas.Count).Row
      Application.ScreenUpdating = False
      With .Cells(1).Resize(lr)
        Set rVis = .SpecialCells(xlVisible)
        ActiveSheet.ShowAllData
        nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
        With .Resize(, nc)
          .Columns(nc).Value = 1
          Intersect(rVis.EntireRow, .Columns(nc)).ClearContents
          .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
          .Columns(nc).SpecialCells(xlConstants, xlNumbers).EntireRow.Delete
        End With
      End With
      Application.ScreenUpdating = True
    Else
      MsgBox "No hidden rows"
    End If
  End With
End Sub

 

[LAAdams17]

Another option:

Sub a1167354b()
Dim r As Range, q As Range

Set q = ActiveSheet.UsedRange.Columns("A").Offset(1)
Set r = q.SpecialCells(xlCellTypeVisible)

Range("A1").AutoFilter
r.EntireRow.Hidden = True
q.SpecialCells(xlCellTypeVisible).EntireRow.ClearContents
q.EntireRow.Hidden = False

End Sub

but after running the code you need to sort the data to remove the blank rows.

@Peter_SSs
this part:
Rws = Split(Range("A1:A" & lr).SpecialCells(xlVisible).Address(0, 0), ",")

I think it only works if the address doesn't exceed 256 characters. So if there are, say hundreds of non-contiguous areas then it won't work correctly.

This by far is the quickest solution that I've found which works for me. THANK YOU!