Delete hidden rows *runs slowly* [VBA]

[Martin_H]

Hi,

I am using this code to copy data from workbook_data and paste it into workbook_master (see below).

Then I filter out all unnecessary data.

Then I delete all hidden rows (the rows I filtered out in previous step).

Now, the problem is that it takes a while to complete the last step (see the code below -> 'Delete hidden rows)

Would it be possible to somehow speed up the last part?

Thank you.

'Open workbook_data
Workbooks.Open ("address")

'Copy data from workbook_data, from worksheet data
Workbooks("workbook_data.xlsx").Sheets("data").Range("A1", Range("H" & Rows.count).End(xlUp)).Copy

'Paste copied data inside workbook_master, inside worksheet master
Workbooks("workbook_master.xlsm").Sheets("master").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'Close workbook_data without save
On Error Resume Next
Workbooks("workbook_data.xlsx").Close savechanges:=False
On Error GoTo 0

'Workbook_master with sheet master is now activated
'Filter the header in the range A1 based on values in the cells G4, H4 and I4 in the worksheet Sheet_X
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array(Worksheets("Sheet_X").Range("G4").Value, Worksheets("Sheet_X").Range("H4").Value, Worksheets("Sheet_X").Range("I4").Value), Operator:=xlFilterValues

'Delete hidden rows
Dim sht As Worksheet
Dim lastrow
Set sht = ActiveSheet
lastrow = sht.UsedRange.Rows(sht.UsedRange.Rows.count).Row
For i = lastrow To 1 Step -1
If Rows(i).Hidden = True Then Rows(i).EntireRow.DELETE
Next

 

[rpaulson]

try this on a copy of your file.

Dim lastrow
Set sht = ActiveSheet
lastrow = sht.UsedRange.Rows(sht.UsedRange.Rows.count).Row

With Range("a1", Range("a" & lastrow)
    .SpecialCells(12).Select
    .Cells.EntireRow.Hidden = False
    Selection.EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .Cells.EntireRow.Hidden = False
End With

 

[Martin_H]

Hi rpaulson,

so I have repaced the last part of my code with yours (see below) and I got an error "No cells were found." with this line lighlighted. The code deleted basically every line in my worksheet.

.SpecialCells(12).EntireRow.DELETE

Full code here?

'Open workbook_data
Workbooks.Open ("address")

'Copy data from workbook_data, from worksheet data
Workbooks("workbook_data.xlsx").Sheets("data").Range("A1", Range("H" & Rows.count).End(xlUp)).Copy

'Paste copied data inside workbook_master, inside worksheet master
Workbooks("workbook_master.xlsm").Sheets("master").Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

'Close workbook_data without save
On Error Resume Next
Workbooks("workbook_data.xlsx").Close savechanges:=False
On Error GoTo 0

'Workbook_master with sheet master is now activated
'Filter the header in the range A1 based on values in the cells G4, H4 and I4 in the worksheet Sheet_X
ActiveSheet.Range("A1").AutoFilter Field:=1, Criteria1:=Array(Worksheets("Sheet_X").Range("G4").Value, Worksheets("Sheet_X").Range("H4").Value, Worksheets("Sheet_X").Range("I4").Value), Operator:=xlFilterValues

'rpaulson
Dim lastrow
Set sht = ActiveSheet
lastrow = sht.UsedRange.Rows(sht.UsedRange.Rows.count).Row

With Range("a1", Range("a" & lastrow))
    .SpecialCells(12).Select
    .Cells.EntireRow.Hidden = False
    Selection.EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .Cells.EntireRow.Hidden = False
End With

 

[Gokhan Aycan]

Tried using the regular speed gaining code?

Application.EnableEvents = True/False
Application.ScreenUpdating = True/False
Application.Calculation = xlCalculationManual/xlManualCalculation

 

[Martin_H]

Tried using the regular speed gaining code?

Application.EnableEvents = True/False
Application.ScreenUpdating = True/False
Application.Calculation = xlCalculationManual/xlManualCalculation

Yes sir. I have it all at the start of my procedure.

 

[rpaulson]

oops need to error trap if no hidden rows. otherwise it will hide all rows

On Error Resume Next

Dim lastrow
Set sht = ActiveSheet
lastrow = sht.UsedRange.Rows(sht.UsedRange.Rows.Count).Row

With Range("a1", Range("a" & lastrow))
    .SpecialCells(12).Select
    .Cells.EntireRow.Hidden = False
    Selection.EntireRow.Hidden = True
    .SpecialCells(12).EntireRow.Delete
    .Cells.EntireRow.Hidden = False
End With

On Error GoTo 0

 

[Gokhan Aycan]

My belief is if you:

1- Use Advanced Filtering of the data to copy to a dummy sheet
2- Delete every data row in one line
3- Paste back the range from dummy

would be fastest.

 

[gravanoc]

You've probably already tried this, but if those other things aren't working, then restarting Excel or your CPU may be required.

 

[Akuini]

@Martin_H
I wrote a code to answer to a similar problem which is how to delete hidden rows fast.
Check these:

Delete hidden rows using VBA and an array?

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...

www.mrexcel.com

Need to genericize VBA code

I need help making the code in Macro2 (see below) work on the active table which can start on A1 or another row. What I'm attempting to do is run the DeleteHiddenRows9 macro, move to the first column, sort the table based on data in the first column (smallest to largest), find the last cell with...

www.mrexcel.com

note:
deleting rows on a large non-contiguous range is slow, so it's better just to clear the content first and then sort data to "remove" the blank rows.

 

[FormR]

You could also consider applying the filter to the source workbook and only copying the visible rows to the destination workbook, removing the need to delete anything.