[RESOLVED] Clear Empty Rows and Columns

I have a procedure that I wrote to clear the empty rows and columns in a spreadsheet. The issue is it takes a lot longer than I'd like it to...my program is supposed to be a faster alternative to completing a task manually, and with this much needed procedure that task is not accomplished in a timely manner. Does anyone know of an easier way to accomplish this? Here's my code:

(objbook, objexcel, and objworksheet were all defined before the procedure is called)

Code:

---

Public Sub ClearEmpties()
    Dim intIndex As Integer, intIndex2 As Integer
    Dim blnHasData As Boolean, blnDeleted As Boolean
   
    blnHasData = False
    blnDeleted = True
    intIndex = 0
    intIndex2 = 0
    objExcel.Visible = True
   
    'Clear Rows
    Do Until blnDeleted = False
        DoEvents
        blnDeleted = False
       
        For intIndex = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
            DoEvents
            For intIndex2 = 1 To objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Column
                If objWorksheet.Cells(intIndex, intIndex2).Text <> "" Then
                    blnHasData = True
                    GoTo NextRow:
                End If
            Next intIndex2
           
            If blnHasData = False Then
                objWorksheet.Rows(intIndex).Select
                objExcel.Selection.Delete Shift:=xlUp
                blnDeleted = True
            End If
           
NextRow:
            blnHasData = False
           
        Next intIndex
       
        objBook.Save
    Loop
   
    blnHasData = False
    blnDeleted = True
   
    'Clear Columns
    Do Until blnDeleted = False
        DoEvents
        blnDeleted = False
       
        For intIndex = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
            DoEvents
            For intIndex2 = 1 To objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
                If objWorksheet.Cells(intIndex2, intIndex).Text <> "" Then
                    blnHasData = True
                    GoTo NextCol:
                End If
            Next intIndex2
           
            If blnHasData = False Then
                objWorksheet.Columns(intIndex).Select
                objExcel.Selection.Delete Shift:=xlLeft
                blnDeleted = True
            End If
           
NextCol:
            blnHasData = False
           
        Next intIndex
       
        objBook.Save
    Loop
End Sub

---

All help is appreciated!

Well for a start, DoEvents intentionally slows your code down (and re-draws the screen), so don't run it more often than you have to.

Next up, saving a workbook takes a large amount of time.. so don't do it inside a loop. If you have it at all, it should only be as the very last line of the routine.

What is the purpose of the blnDeleted loops? As far as I can see there will be nothing to delete the second time (as you deleted it the first time), so you are running the code twice for no reason.

There are other (more complex) ways to speed it up, but these should make a large difference.


I don't know how much time (if any) it will save, but it is safer to avoid using Selection, which you can do by changing this:

Code:

---

                objWorksheet.Rows(intIndex).Select
                objExcel.Selection.Delete Shift:=xlUp

---

to this:

Code:

---

                objWorksheet.Rows(intIndex).Delete Shift:=xlUp

---

Note that (as is almost always the case), there is no need for the dreaded "GoTo" in your code.. in this code, it can simply be replaced by: Exit For

Thank you Si.

Quote:

---

Next up, saving a workbook takes a large amount of time.. so don't do it inside a loop. If you have it at all, it should only be as the very last line of the routine.

---

I did this originally but i didn't think it worked because it kept going through the loop over and over again due to the fact that the columns and rows weren't deleting for some reason...but it works now so thank you again.

Quote:

---

What is the purpose of the blnDeleted loops? As far as I can see there will be nothing to delete the second time (as you deleted it the first time), so you are running the code twice for no reason.

---

I had these in there because originally I was starting at the first column and first row and incrementing the row/col num, but when it got to the end it kept doing the same column/row over and over and over again. I didn't realize that when I changed it to step -1 that I no longer required them.

So here's my code now, if anyone can simplify it even more to make it even faster I just might give you a present :D

Code:

---

Public Sub ClearEmpties()
    Dim intIndex As Integer, intIndex2 As Integer
    Dim blnHasData As Boolean
   
    blnHasData = False
    intIndex = 0
    intIndex2 = 0
    objExcel.Visible = True
   
    'Clear Rows
   
    For intIndex = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
        For intIndex2 = 1 To objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Column
            DoEvents
            If objWorksheet.Cells(intIndex, intIndex2).Text <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Rows(intIndex).Delete Shift:=xlUp
        End If
        blnHasData = False
       
    Next intIndex
       
    blnHasData = False
   
    'Clear Columns
       
    For intIndex = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Column To 1 Step -1
        For intIndex2 = 1 To objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            If objWorksheet.Cells(intIndex2, intIndex).Text <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Columns(intIndex).Delete Shift:=xlLeft
        End If
       
        blnHasData = False
       
    Next intIndex
   
    objBook.Save

End Sub

---

You've actually made the DoEvents quite a bit worse.. rather than running it once per row + once per column (ignoring the previous blnDeleted repetition), you are now running it once per cell. Assuming 100 rows and 50 columns, that has gone from 150 (100+50) to 5000 (100*50), which is quite a bit more!

What I would do is put it just before "Next intIndex", but with a little modification to run it less frequently, eg:

Code:

---

If intIndex Mod 50 = 0 Then DoEvents

---

(this will be once every 50 rows/columns, but you may find that isn't often enough)

As the number of columns wont change while you are deleting rows (and vice versa), you could store the result of the xlCellTypeLastCell to a variable before each of the sections begin, and then use that variable with the For loops. While not a massive change, it should be an improvement in speed, as a variable is faster than a property (especially when it is a property of a function of a property!).

With minor reorganisation, there is a bit of code you could remove.. if you move blnHasData = False from the bottom of the For loops to the top, you don't need to set it beforehand. You also don't need to set the Index variables, as they are set by the For loops.

Oh, and setting the application to be visible makes it quite a bit slower... but I guess you may want to watch it working.

Oh man, I love this! I don't really have formal training in this stuff so I don't know ways to make my code efficient...if you hadn't noticed lol.

So now I've got this:

Code:

---

Public Sub ClearEmpties()
    Dim intIndex As Integer, intIndex2 As Integer
    Dim blnHasData As Boolean
    Dim intLastRow As Integer, intLastCol As Integer
   
    objExcel.Visible = True
   
    intLastRow = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
    intLastCol = objWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Column
   
    'Clear Rows
    For intIndex = intLastRow To 1 Step -1
        blnHasData = False
       
        For intIndex2 = 1 To intLastCol
            If objWorksheet.Cells(intIndex, intIndex2).Text <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Rows(intIndex).Delete Shift:=xlUp
        End If
       
        If intIndex Mod 50 = 0 Then DoEvents
    Next intIndex
     
    'Clear Columns
    For intIndex = intLastCol To 1 Step -1
        blnHasData = False
       
        For intIndex2 = 1 To intLastRow
            If objWorksheet.Cells(intIndex2, intIndex).Text <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Columns(intIndex).Delete Shift:=xlLeft
        End If
       
        If intIndex Mod 50 = 0 Then DoEvents
    Next intIndex
   
    objBook.Save

End Sub

---

Anything else I can do?

There is some advice on making code efficient in the "optimisation" section of our Classic VB FAQs (in the FAQ forum, which is shown near the top of our home page), but we have already covered most of what you can do here.


Depending on how many rows are deleted, the value of intLastRow may be a fair bit higher than needed (thus meaning you spend time checking cells that you already know are blank). As such, you should set that variable at the start of the "Clear Columns" section.

It doesn't really matter if you also keep it at the start of "Clear Rows", or put the intIndex For loop back to how it was - as the values of the intIndex For loop are only calculated once (but the ones for intIndex2 are calculated intLastRow times).


If you know how to work with arrays, there is another way of making it even faster.. by never actually reading from a cell. There is a nice little feature of Excel which allows you to put all of the text from the cells of a Range directly into an array, and you can then read the array instead. To see how to do it, check out post #6 of my Excel tutorial (link in my signature).

In the past I have found this to be about 5 times faster, but with what you are doing I don't think it will be as dramatic (I suspect the deleting will take a fair percentage of the time).

A word of warning tho... it doesn't get automatically updated, so you need to read into the array at the start of "Clear Rows" and "Clear Columns".

Si...I could marry you.

So this is what I have now and it's pretty damn fast...

Code:

---

Public Sub ClearEmpties()
    Dim intIndex As Integer, intIndex2 As Integer
    Dim blnHasData As Boolean
    Dim vArray As Variant
   
    objExcel.Visible = True
       
    vArray = objWorksheet.UsedRange.Value
   
    'Clear Rows
    For intIndex = UBound(vArray, 1) To 1 Step -1
        blnHasData = False
       
        For intIndex2 = UBound(vArray, 2) To 1 Step -1
            If vArray(intIndex, intIndex2) <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Rows(intIndex).Delete Shift:=xlUp
        End If
       
        If intIndex Mod 50 = 0 Then DoEvents
    Next intIndex
         
    'Clear Columns
    For intIndex = UBound(vArray, 2) To 1 Step -1
        blnHasData = False
       
        For intIndex2 = UBound(vArray, 1) To 1 Step -1
            If vArray(intIndex2, intIndex) <> "" Then
                blnHasData = True
                Exit For
            End If
        Next intIndex2
       
        If blnHasData = False Then
            objWorksheet.Columns(intIndex).Delete Shift:=xlLeft
        End If
       
        If intIndex Mod 50 = 0 Then DoEvents
    Next intIndex
       
    objBook.Save

End Sub

---

Thank you!!!!!

:lol:

I'm glad you're happy with it. :)

To work with array is a good idea for "small" UsedRange.
* With a large spreadsheet, say 50,000 rows and 200 columns, you will need to allocate memory for a 2-D array with 10 million elements of type Variant. That won't be efficient.
* For sure, when copying a range to an array, only cell values are copied, you will not know if the cells contain any formula that produce blank value.
There are 3 properties of a cell that people may misuse them: .Value, .Text and .Formula. They may or may not the same with each other.

Ex1.
Cell B2 contains formula =IF(A2>10,1,0) and the Number format of B2 is 0;-0;"".
When A2=15, you will have B2=0 but the display of B2 is blank. In this case, you have:
B2.Formula = "=IF(A2>10,1,0)"
B2.Value = 0
B2.Text = ""

Ex2.
With Ex1 above, now change the formula to:
B2.Formula = "=IF(A2>10,1,"")"
you will have:
B2.Value = ""
B2.Text = ""
When copying to array, you will have vArray(2,2) = "", but actually B2 or Cells(2,2) is not empty.

Another important error with the code in post#7 is when the first row or the first column is blank, then the indice of array will not match with row numbers and column numbers ==> you may delete wrong columns/rows.

Try this to see how faster it is.
In this code I used .End method to test whether a column or a row is blank.
A blank column/row won't be deleted straight away but is is postponed into a union range aRange, this aRange that combines all blank columns/rows will be deleted at once at the end of each loop.

Code:

---

Sub DeleteBlankRowsAndColumns()
  Dim r As Long, r2 As Long
  Dim c As Long, c2 As Long
  Dim MaxRow As Long
  Dim MaxCol As Long
  Dim aRange As Range
 
  objExcel.Visible = False
 
  With objWorksheet
      MaxRow = .Rows.Count
      MaxCol = .Columns.Count

      '-- Delete blank columns
      c2 = .UsedRange.Column + .UsedRange.Columns.Count - 1
      For c = 1 To c2
        r = .Cells(1, c).End(xlDown).Row
        If r = MaxRow Then
            If .Cells(r, c).Formula = "" Then
                If aRange Is Nothing Then
                  Set aRange = .Columns(c)
                Else
                  Set aRange = Union(aRange, .Columns(c))
                End If
            End If
        End If
      Next
      If Not aRange Is Nothing Then
        aRange.Delete
        Set aRange = Nothing
      End If
     
      '-- Delete blank rows
      r2 = .UsedRange.Row + .UsedRange.Rows.Count - 1
      For r = 1 To r2
        c = .Cells(r, 1).End(xlToRight).Column
        If c = MaxCol Then
            If .Cells(r, c).Formula = "" Then
                If aRange Is Nothing Then
                  Set aRange = .Rows(r)
                Else
                  Set aRange = Union(aRange, .Rows(r))
                End If
            End If
        End If
      Next
      If Not aRange Is Nothing Then
        aRange.Delete
        Set aRange = Nothing
      End If
 
  End With
 
  objExcel.Visible = True
  objBook.Save

End Sub

---