Using UNION and Ranges To Speed Up Deleting Many Columns?

[eryksd]

Trying to use Union and ranges to speed up deleting empty columns, but going wrong somewhere with the code.

I read here that deleting columns individually slows down performance significantly. Script speed can be improved by defining a "master" range to include all the ranges (columns) to be deleted (by using Union), and then simply deleting the "master" range.

My old (slow) script that works, but takes about about 3 hours to run across ~30 sheets and deleting ~100 columns each sheet. Using Union is supposed to make the process run in seconds instead of hours, was hoping someone could help me figure out what I'm doing wrong with my code. When I run it, nothing happens... not sure what's going on.

Any help would be greatly appreciated!

<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub Delete_No_Data_Columns_Optimized()

    Dim col As Long
    Dim h 'to store the last columns/header
    Dim EventState As Boolean, CalcState As XlCalculation, PageBreakState As Boolean
    Dim columnsToDelete As Range

    On Error GoTo EH:
    'Optimize Performance

    Application.ScreenUpdating = False
    EventState = Application.EnableEvents
    Application.EnableEvents = False

    CalcState = Application.Calculation
    Application.Calculation = xlCalculationManual

    PageBreakState = ActiveSheet.DisplayPageBreaks
    ActiveSheet.DisplayPageBreaks = False

' <<<<<<<<<<<<< MAIN CODE >>>>>>>>>>>>>>

    h = Range("E1").End(xlToRight).Column 'find the last column with the data/header


    For col = h To 5 Step -1
        If Application.CountA(Columns(col)) = 1 Then  
            If columnsToDelete Is Nothing Then
                Set columnsToDelete = Worksheets("Ball Shaker").Column(col)
                
            Else
                Set columnsToDelete = Application.Union(columnsToDelete, Worksheets("Ball Shaker").Column(col))
                
            End If
        End If
    Next col

    If Not columnsToDelete Is Nothing Then
        columnsToDelete.Delete
    End If

' <<<<<<<<<<<< END MAIN CODE >>>>>>>>>>>>>>

CleanUp:
    'Revert optmizing lines
    On Error Resume Next
    ActiveSheet.DisplayPageBreaks = PageBreakState
    Application.Calculation = CalcState
    Application.EnableEvents = EventState
    Application.ScreenUpdating = True
Exit Sub
EH:
    ' Handle Errors here

    Resume CleanUp
End Sub</code>

 

[Rick Rothstein]

Hello Rick, thank you for the code!

It actually ran 32 seconds faster

First solution I listed: 9:29 minutes
Your code: 8:57 minutes

I actually thought it might run faster than that. I am confused, though, because back in Message #5 you said "This new code seems to work well (runs in ~6 minutes across all sheets)" but now you are saying 9.29 minutes.

Just out of curiosity, do you get any speed increase by changing this line of code (from inside the inner For..Next loop)...

If Application.CountA(WS.Columns(X)) = 1 Then WS.Cells(1, X) = ""

to this...

[table="width: 500"]
[tr]
	[td]If Application.CountA(Intersect(WS.Columns(X), WS.UsedRange)) = 1 Then WS.Cells(1, X) = ""[/td]
[/tr]
[/table]

or even possibly to this...

If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""

 

[StephenCrump]

I actually thought it might run faster than that. I am confused, though, because back in Message #5 you said "This new code seems to work well (runs in ~6 minutes across all sheets)" but now you are saying 9.29 minutes.

Rick, I am also surprised at the order of time taken.

If I dummy up several hundred columns, alternately blank, across a dozen sheets, your code takes about one second to run on my machine.

eryksd, how many workbooks/sheets/columns are you running this on?

 

[eryksd]

I actually thought it might run faster than that. I am confused, though, because back in Message #5 you said "This new code seems to work well (runs in ~6 minutes across all sheets)" but now you are saying 9.29 minutes.

Just out of curiosity, do you get any speed increase by changing this line of code (from inside the inner For..Next loop)...

If Application.CountA(WS.Columns(X)) = 1 Then WS.Cells(1, X) = ""

to this...

[TABLE="width: 500"]
<tbody>[TR]
[TD]If Application.CountA(Intersect(WS.Columns(X), WS.UsedRange)) = 1 Then WS.Cells(1, X) = ""[/TD]
[/TR]
</tbody>[/TABLE]

or even possibly to this...

If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""

I will try those out and let you know, thanks Rick.

It took ~6 minutes the first time since I used a stopwatch and was just eyeing it while working on something else, so I might have been off, I'm pretty sure it ran for around that length of time though.

This morning I ran both scripts, and added a timer, so that I could give a more accurate estimate. Got the timer code from here.

Maybe the timer code slowed it down?

Rick, I am also surprised at the order of time taken.

If I dummy up several hundred columns, alternately blank, across a dozen sheets, your code takes about one second to run on my machine.

eryksd, how many workbooks/sheets/columns are you running this on?

Alot - 1 workbook / ~30 sheets / ~100 columns per sheet, and probably ~90 of those are empty. There are also anywhere from 1 to almost 1000 rows on some sheets.

 

[eryksd]

I actually thought it might run faster than that. I am confused, though, because back in Message #5 you said "This new code seems to work well (runs in ~6 minutes across all sheets)" but now you are saying 9.29 minutes.

Just out of curiosity, do you get any speed increase by changing this line of code (from inside the inner For..Next loop)...

If Application.CountA(WS.Columns(X)) = 1 Then WS.Cells(1, X) = ""

to this...

[TABLE="width: 500"]
<tbody>[TR]
[TD]If Application.CountA(Intersect(WS.Columns(X), WS.UsedRange)) = 1 Then WS.Cells(1, X) = ""[/TD]
[/TR]
</tbody>[/TABLE]

or even possibly to this...

If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""

I tried running it with both codes, the first alternate code kept giving me an error (Run-time error '5': Invalid procedure call or argument). I couldn't figure out why.

The second code deleting all of the columns, even the ones with data inside of them (the columns sporadically had data in them, sometimes a keyword all the way down, or a group of keywords here and there) - It did run in 6 seconds though across all sheets.

 

[StephenCrump]

It did run in 6 seconds though across all sheets.

That's more like the time I'd expect.

Let's ditch the first alternative .. it doesn't allow for the possibility of blank columns before the UsedRange.

Are you sure that the 2nd alternative code deleted columns with values in them? This line of code:

If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""

will set the value in row 1 equal to "" (tagging it for later deletion) only if the column is entirely empty, or if it contains a value (which we're assuming is just a header) in row 1.

Based on your original post, we're assuming your headers are in row 1. Is this correct?

 

[eryksd]

That's more like the time I'd expect.

Let's ditch the first alternative .. it doesn't allow for the possibility of blank columns before the UsedRange.

Are you sure that the 2nd alternative code deleted columns with values in them? This line of code:

If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""

will set the value in row 1 equal to "" (tagging it for later deletion) only if the column is entirely empty, or if it contains a value (which we're assuming is just a header) in row 1.

Based on your original post, we're assuming your headers are in row 1. Is this correct?

That is correct, headers are in row 1.

Weird, I tried to run it again, and in the beginning when the screen updated in looked like it only deleted the columns without values (the result we're seeking), but after the script had ended after a few minutes, I saw it had deleted everything again.

Here is the full code (for running across sheets) - maybe I messed something up on the part where it runs across other sheets.

Sub Delete_No_Data_Columns_Optimized_AllSheets()

Dim sht As Worksheet


For Each sht In Worksheets


Dim StartTime As Double
Dim MinutesElapsed As String


'Remember time when macro starts
  StartTime = Timer


'*****************************
'Insert Your Code Here...
'*****************************
    
    If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then
        sht.Activate    'go to that Sheet!
        DeleteEmptyColumns_Rick_v2 sht.Index  'run the code, and pass the sht.Index _
                                                    'of the current sheet to select that sheet
    End If
Next sht    'next sheet please!


'Determine how many seconds code took to run
  MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")


'Notify user in seconds
  MsgBox "This code ran successfully in " & MinutesElapsed & " minutes", vbInformation




End Sub

Sub DeleteEmptyColumns_Rick_v2(shtIndex As Integer)  Dim X As Long, LastCol As Long, WS As Worksheet
  Dim ScreenUpdateState As Boolean
  Dim StatusBarState As Boolean
  Dim CalcState As Long
  Dim EventsState As Boolean
  Dim DisplayPageBreakState As Boolean
  
  
  
  '  Save the current state of Excel settings.
  ScreenUpdateState = Application.ScreenUpdating
  StatusBarState = Application.DisplayStatusBar
  CalcState = Application.Calculation
  EventsState = Application.EnableEvents
  
  '  Turn off Excel functionality to improve performance.
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  
  Set WS = Sheets(shtIndex)
  
  For Each WS In Worksheets
    DisplayPageBreakState = WS.DisplayPageBreaks
    WS.DisplayPageBreaks = False
    LastCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column
    For X = 1 To LastCol
      If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""
    Next
    On Error Resume Next
    WS.Range("A1").Resize(, LastCol).SpecialCells(xlBlanks).EntireColumn.Delete
    On Error GoTo 0
    WS.DisplayPageBreaks = DisplayPageBreakState
  Next
  
  '  Restore Excel settings to original state.
  Application.ScreenUpdating = ScreenUpdateState
  Application.DisplayStatusBar = StatusBarState
  Application.Calculation = CalcState
  
  
End Sub

 

[Rick Rothstein]

Sub DeleteEmptyColumns_Rick_v2(shtIndex As Integer)  Dim X As Long, LastCol As Long, WS As Worksheet
  Dim ScreenUpdateState As Boolean
  Dim StatusBarState As Boolean
  Dim CalcState As Long
  Dim EventsState As Boolean
  Dim DisplayPageBreakState As Boolean
  
  
  
  '  Save the current state of Excel settings.
  ScreenUpdateState = Application.ScreenUpdating
  StatusBarState = Application.DisplayStatusBar
  CalcState = Application.Calculation
  EventsState = Application.EnableEvents
  
  '  Turn off Excel functionality to improve performance.
  Application.ScreenUpdating = False
  Application.DisplayStatusBar = False
  Application.Calculation = xlCalculationManual
  Application.EnableEvents = False
  
  Set WS = Sheets(shtIndex)
  
  [B][COLOR="#FF0000"]For Each WS In Worksheets[/COLOR][/B]
    DisplayPageBreakState = WS.DisplayPageBreaks
    WS.DisplayPageBreaks = False
    LastCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column
    For X = 1 To LastCol
      If Cells(Rows.Count, X).End(xlUp).Row = 1 Then WS.Cells(1, X) = ""
    Next
    On Error Resume Next
    WS.Range("A1").Resize(, LastCol).SpecialCells(xlBlanks).EntireColumn.Delete
    On Error GoTo 0
    WS.DisplayPageBreaks = DisplayPageBreakState
  [B][COLOR="#FF0000"]Next[/COLOR][/B]

  '  Restore Excel settings to original state.
  Application.ScreenUpdating = ScreenUpdateState
  Application.DisplayStatusBar = StatusBarState
  Application.Calculation = CalcState
  
  
End Sub

You changed my code to receive a single sheet reference as an argument... given that, you need to remove the loop that iterates all the worksheets and let your single sheet be the only sheet processed by the code. Delete the two lines of code shown in red and see if that makes any difference in your outcome.

 

[eryksd]

You changed my code to receive a single sheet reference as an argument... given that, you need to remove the loop that iterates all the worksheets and let your single sheet be the only sheet processed by the code. Delete the two lines of code shown in red and see if that makes any difference in your outcome.

Your right, didn't see that.

It works this time- though it took 11 minutes.

 

[Rick Rothstein]

It works this time- though it took 11 minutes.

It might be more efficient to include the code that excludes those certain webpages directly within my original code so that all those settings are not being repeatedly stored, set and reset with each worksheet. With that said, 11 minutes surprises me given the number of sheets and columns involved.