Efficiently delete all hidden columns and rows in a worksheet

Question

To delete all hidden columns and rows in a worksheet I am using:

 With activeworkbook.Sheets(1)

           LR = LRow(activeworkbook.Sheets(1)) ' will retrieve last row no in the sheet
           lc = LCol(activeworkbook.Sheets(1)) ' will retrieve last column no in the sheet

            For lp = lc To 1 Step -1    'loop through all columns
                If .Columns(lp).EntireColumn.Hidden = True Then .Columns(lp).EntireColumn.Delete
            Next lp

            For lp = LR To 1 Step -1    'loop through all rows
                If .Rows(lp).EntireRow.Hidden = True Then .Rows(lp).EntireRow.Delete
            Next
end with

But it takes a very long time as I have more than 300 columns and 1,000 rows. When I tried to estimate the total time required for the above operations, I found the following lines took most time:

For lp = lc To 1 Step -1    'loop through all columns
    If .Columns(lp).EntireColumn.Hidden = True Then _
         .Columns(lp).EntireColumn.Delete
Next lp

but the next loop is much faster.

Do you have any suggestions to improve the execution speed?

The code for LRow and LCol functions is below and I confirm it returns the correct last row and last column:

Function LRow(sh As Worksheet)
    On Error Resume Next
    LRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            matchCase:=False).Row
    On Error GoTo 0
End Function


Function LCol(sh As Worksheet)
    On Error Resume Next
    LCol = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            matchCase:=False).Column
    On Error GoTo 0
End Function

I was looking at using .specialcells for selecting all visible columns, and reverse it for deletion.

Would have been nice to confirm that your `LCol(...)` function is returning the correct column. As this is typically a single short code line, I question whether a sub-function like that is even necessary let alone returning the correct column index number. Use `Applciation.ScreenUpdating = False` to speed things up. If you are deleting formulas, set calculation to `xlCalculationManual`. `EnableEvents` usually cuts off a few ms as well. — , Sep 22 '15 at 11:14
What happens if you switch both loops, i.e. delete rows first, columns after that? — LocEngineer, Sep 22 '15 at 12:28
good question, tried and confirm that still rows deletion are much faster than column deletion — cooolboy, Sep 22 '15 at 12:42
Try with all settings as mentioned in the OP here: http://stackoverflow.com/questions/5394239/column-row-operations-insert-delete-are-very-slow-in-excel-2010 — LocEngineer, Sep 22 '15 at 13:11

score 1 · Answer 1 · edited May 23 '17 at 12:14

1

You can scan the rows and columns first and then delete them as batch, take a look at this :

Sub cooolboy()

Dim Ws As Worksheet, _
    lp As Long, _
    lR As Long, _
    lC As Integer, _
    RowToDelete As String, _
    ColToDelete As String

Set Ws = ActiveWorkbook.Sheets("Sheet4")
RowToDelete = ""
ColToDelete = ""

With Ws
    lR = .Range("A" & .Rows.Count).End(xlUp).Row         'will retrieve last row no in the sheet
    lC = .Cells(1, .Columns.Count).End(xlToLeft).Column  'will retrieve last column no in the sheet

    For lp = 1 To lC    'loop through all columns
        If .Columns(lp).EntireColumn.Hidden Then _
            ColToDelete = ColToDelete & "," & Col_Letter(lp) & ":" & Col_Letter(lp)
    Next lp

    For lp = 1 To lR   'loop through all rows
        If .Rows(lp).EntireRow.Hidden Then _
            RowToDelete = RowToDelete & "," & lp & ":" & lp
    Next lp
    'Get rid of the first comma
    If ColToDelete <> "" Then ColToDelete = Right(ColToDelete, Len(ColToDelete) - 1)
    If RowToDelete <> "" Then RowToDelete = Right(RowToDelete, Len(RowToDelete) - 1)
    'MsgBox ColToDelete & vbCrLf & RowToDelete
    If ColToDelete <> "" Then .Range(ColToDelete).Delete Shift:=xlToLeft
    If RowToDelete <> "" Then .Range(RowToDelete).Delete Shift:=xlUp
End With

End Sub

Function Col_Letter(lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

Further more, take a look at this post for finding the last row and column : Error in finding last used cell in VBA

edited May 23 '17 at 12:14

Community

1
1

answered Sep 22 '15 at 12:50

R3uK

14,417
7
43
77

Thanks...when executing the above code, I am getting Application Defined or Object Defined Error at .Range(ColToDelete).Delete Shift:=xlToLeft – cooolboy Sep 22 '15 at 14:31
Silly question, but have you made sure you had hidden columns? Because it was working fine for me... I just didn't test it for only 1 row or column. Take a look a the correction in the edit. – R3uK Sep 22 '15 at 14:59
I did try with few columns, it works but doesn't work for many columns together...for instance I am trying to delete columns with the string in ColToDelete – cooolboy Sep 22 '15 at 15:18
EW:EW,EV:EV,EU:EU,ET:ET,ES:ES,ER:ER,EQ:EQ,EP:EP,EO:EO,EN:EN,EM:EM,EL:EL,EK:EK,EJ:EJ,EI:EI,EH:EH,BY:BY,BX:BX,BW:BW,BV:BV,BU:BU,BT:BT,BS:BS,BR:BR,BQ:BQ,BP:BP,BO:BO,BN:BN,BM:BM,BL:BL,BK:BK,BJ:BJ,BI:BI,BH:BH,BG:BG,BE:BE,BD:BD,BC:BC,BB:BB,BA:BA,AU:AU,AT:AT,AS:AS,AR:AR,AQ:AQ,AP:AP,AO:AO,AN:AN,AM:AM,AL:AL,AK:AK,AJ:AJ,AI:AI,AH:AH,AG:AG,AF:AF,AE:AE,AD:AD,AC:AC,AB:AB,AA:AA,Z:Z,Y:Y,X:X,W:W,V:V,U:U,T:T,S:S,R:R,Q:Q,P:P,O:O,N:N,M:M,L:L,K:K,J:J,I:I,H:H,G:G,F:F,E:E,D:D,C:C,B:B – cooolboy Sep 22 '15 at 15:21
Okay... So maybe, if you define a counter and check after what limit this doesn't work anymore and get out of the loop to delete these and restart the loop (you'll need to define another variable to restart the loop on the last column/row that was previously scanned). Let me know how this turn out! – R3uK Sep 22 '15 at 15:26
I am doing something wrong, i set counter to 10 and delete columns when counter exceed 10, it works for few loops only and ends with object defined error – cooolboy Sep 23 '15 at 01:53
If .Columns(lp).EntireColumn.Hidden = True Then i = i + 1 ColToDelete = ColToDelete & "," & Col_Letter(lp) & ":" & Col_Letter(lp) If i > 10 Then ColToDelete = Right(ColToDelete, Len(ColToDelete) - 1) .Range(ColToDelete).Delete Shift:=xlToLeft ColToDelete = "" i = 0 End If End If – cooolboy Sep 23 '15 at 01:55
R3UK, thanks for your help and I would give you the credit as well. – cooolboy Sep 23 '15 at 07:57

score 1 · Accepted Answer · edited Aug 16 '17 at 22:59

I managed to get it worked using specialcells as below. This is much faster than the previous methods and works well in Excel 2010 onwards.

Set urng = Activeworkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible)
                If Not urng Is Nothing Then
                    s = Split(urng.Cells(1, 1).Address, "$")
                    LR = LRow(Activeworkbook.Sheets(1))
                    lc = LCol(Activeworkbook.Sheets(1))
                    icol = urng.Cells(1, 1).Column

' delete hidden colums
                    Set urng2 = Activeworkbook.Sheets(1).Range(Cells(s(2), 1), Cells(s(2), lc))
                    Set oVisible = urng2.SpecialCells(xlCellTypeVisible)
                    Set oHidden = urng2

                    oHidden.EntireColumn.Hidden = False
                    oVisible.EntireColumn.Hidden = True

                    Set oHidden = urng2.SpecialCells(xlCellTypeVisible)
                    oHidden.EntireColumn.Delete
                    oVisible.EntireColumn.Hidden = False

' delete hidden rows
                    Set urng = Activeworkbook.Sheets(1).UsedRange.SpecialCells(xlCellTypeVisible)
                    If Not urng Is Nothing Then
                        's = Split(urng.Cells(1, 1).Address, "$")
                        icol = urng.Cells(1, 1).Column

                        Set urng2 = Activeworkbook.Sheets(1).Range(Cells(1, icol), Cells(LR, icol))
                        'urng2.Select
                        Set oVisible = urng2.SpecialCells(xlCellTypeVisible)
                        Set oHidden = urng2

                        oHidden.EntireRow.Hidden = False
                        oVisible.EntireRow.Hidden = True

                        Set oHidden = urng2.SpecialCells(xlCellTypeVisible)
                        oHidden.EntireRow.Delete
                        oVisible.EntireRow.Hidden = False

                    End If
                End If

Efficiently delete all hidden columns and rows in a worksheet

2 Answers2