Thanks Thanks:  0
Likes Likes:  0
Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Using UNION and Ranges To Speed Up Deleting Many Columns?

  1. #1
    Board Regular
    Join Date
    Jan 2016
    Posts
    51
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Question Using UNION and Ranges To Speed Up Deleting Many Columns?

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

  2. #2
    MrExcel MVP
    Moderator
    Scott Huish's Avatar
    Join Date
    Mar 2004
    Location
    Oregon
    Posts
    19,529
    Post Thanks / Like
    Mentioned
    5 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Are you just trying to delete columns that have only 1 cell with data?
    Office 2010/365

  3. #3
    Board Regular
    Join Date
    Sep 2013
    Location
    Blue Mountains, Australia
    Posts
    3,324
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    You have: On Error GoTo EH which is dangerous, because your code can error anywhere, and then it will appear that "nothing happens".

    Your code will error because you need to refer to
    .Columns(col)

    Your code also is hard coded for
    Worksheets("Ball Shaker"). I assume you want to loop through multiple sheets?

  4. #4
    Board Regular
    Join Date
    Feb 2012
    Location
    Florida, USA
    Posts
    10,339
    Post Thanks / Like
    Mentioned
    13 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    This seems to work
    Code:
    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(ActiveSheet.Columns(col)) >= 1 Then
                If columnsToDelete Is Nothing Then
                    Set columnsToDelete = Worksheets("Ball Shaker").Columns(col)
                Else
                    Set columnsToDelete = Application.Union(columnsToDelete, Worksheets("Ball Shaker").Columns(col))
                    
                End If
            End If
        Next col
        If Not columnsToDelete Is Nothing Then
            columnsToDelete.Delete
        End If
    ' <<<<<<<<<<<< END MAIN CODE >>>>>>>>>>>>>>
    CleanUp:
        MsgBox Err.Number    '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
    If you are trying to delete only the columns with one cell of value, then remove the GreaterThan symbol from the CountA statement. There were a couple of typos ibn the Columns(col) with the 's' missing.
    Last edited by JLGWhiz; Feb 2nd, 2016 at 06:12 PM.
    Using Windows 10, Excel 2013.
    Any code provided by me should be tested on a copy or a mock-up of your file before applying it to your original file. Some actions generated by VBA code cannot be reversed with the undo facility in Excel. To open the VB editor, press Alt + F11. To run code from the Excel window, press Alt + F8. Please do not attempt to learn everything about VBA in one thread, especially from me. See this link for attaching images: Attachments

  5. #5
    Board Regular
    Join Date
    Jan 2016
    Posts
    51
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Quote Originally Posted by Scott Huish View Post
    Are you just trying to delete columns that have only 1 cell with data?
    Yes, each column will have a header (1 cell with data)

    Quote Originally Posted by StephenCrump View Post
    You have: On Error GoTo EH which is dangerous, because your code can error anywhere, and then it will appear that "nothing happens".

    Your code will error because you need to refer to
    .Columns(col)

    Your code also is hard coded for
    Worksheets("Ball Shaker"). I assume you want to loop through multiple sheets?
    Good catch on typo, I missed that. Any suggestions on how to handle errors on my code? (See my new working code below, across sheets)

    Quote Originally Posted by JLGWhiz View Post
    This seems to work
    Code:
    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(ActiveSheet.Columns(col)) >= 1 Then
                If columnsToDelete Is Nothing Then
                    Set columnsToDelete = Worksheets("Ball Shaker").Columns(col)
                Else
                    Set columnsToDelete = Application.Union(columnsToDelete, Worksheets("Ball Shaker").Columns(col))
                    
                End If
            End If
        Next col
        If Not columnsToDelete Is Nothing Then
            columnsToDelete.Delete
        End If
    ' <<<<<<<<<<<< END MAIN CODE >>>>>>>>>>>>>>
    CleanUp:
        MsgBox Err.Number    '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
    If you are trying to delete only the columns with one cell of value, then remove the GreaterThan symbol from the CountA statement. There were a couple of typos ibn the Columns(col) with the 's' missing.
    Thank you, yes good catch on Columns type, totally missed that. Working code across sheets below (with fixed typos):

    This new code seems to work well (runs in ~6 minutes across all sheets) - hope I'm handling any potential errors the right way though (I'm still pretty new to vba, not familiar with proper error protocols)

    --------------------------------------

    Code:
    Option Explicit
    
    Sub Delete_No_Data_Columns_Optimized_AllSheets()
    
    
    Dim sht As Worksheet
    
    
    For Each sht In Worksheets
        
        If sht.Name <> "AA" And sht.Name <> "Word Frequency" Then
            sht.Activate    'go to that Sheet!
            Delete_No_Data_Columns_Optimized 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!
    
    
    
    
    End Sub
    
    
    Sub Delete_No_Data_Columns_Optimized(shtIndex As Integer)
    
    
        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
        Dim ws As Worksheet
        
        Set ws = Sheets(shtIndex)   'Set the exact sheet, not just the one that is active _
                                    'and then you will go through all the sheets
        
        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 = ws.Range("E1").End(xlToRight).Column 'find the last column with the data/header
        
                   
        For col = h To 5 Step -1
            If ws.Application.CountA(Columns(col)) = 1 Then  'Columns(col).Delete
                If columnsToDelete Is Nothing Then
                    Set columnsToDelete = ws.Columns(col)
                Else
                    Set columnsToDelete = Application.Union(columnsToDelete, ws.Columns(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

  6. #6
    MrExcel MVP Jonmo1's Avatar
    Join Date
    Oct 2006
    Location
    Bryan, TX
    Posts
    44,054
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    If each column will have a header, so the 1 cell will be row 1.

    Instead of invoking the worksheet function COUNTA,
    If Application.CountA(Columns(col)) = 1 Then

    Try changing that to
    If Cells(Rows.Count, col).End(xlUp).Row = 1 Then
    Use the MrExcel HTML Maker to post nicely formatted tables in your forum posts.
    Find a link in post number 31

    The more we learn, and the better we get at our trade, the easier it becomes to overlook the obvious.

    Life moves pretty fast. If you don't stop and look around once in a while, you could miss it.
    Ferris Bueller A.K.A. John Hughes, 1986

  7. #7
    MrExcel MVP Jonmo1's Avatar
    Join Date
    Oct 2006
    Location
    Bryan, TX
    Posts
    44,054
    Post Thanks / Like
    Mentioned
    19 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Also, since you have it split into 2 macros (1 to loop the sheets, 1 to delete the columns of specified sheet)
    You should enable/disable the calculations events and such in the FIRST macro, not the macro called by the first.

    The way you have it, calculations get disabled/re-enabled for each iteration of the sheet loop.

    It would be better to just disable calculations once from the first macro.
    Do ALL the sheets
    THEN re-enable calculations after all the sheets are done.
    Last edited by Jonmo1; Feb 2nd, 2016 at 08:02 PM.
    Use the MrExcel HTML Maker to post nicely formatted tables in your forum posts.
    Find a link in post number 31

    The more we learn, and the better we get at our trade, the easier it becomes to overlook the obvious.

    Life moves pretty fast. If you don't stop and look around once in a while, you could miss it.
    Ferris Bueller A.K.A. John Hughes, 1986

  8. #8
    Board Regular
    Join Date
    Sep 2013
    Location
    Blue Mountains, Australia
    Posts
    3,324
    Post Thanks / Like
    Mentioned
    3 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Quote Originally Posted by eryksd View Post
    Any suggestions on how to handle errors on my code?
    Once your code is cleaned up and working (e.g. using JLGWhiz's and Jonmo1's suggestions) it will probably work fine for months or years. If it was my code, and I was the only one using it, my inclination would be to deal with errors/unexpected results only if/when they occurred.

    What I definitely wouldn't do is to put:

    Code:
    On Error GoTo Somewhere 'where Somewhere: doesn't actually handle errors!
    'or
    On Error Resume Next
    at the start of my code, as effectively this ignores errors, and the code/results will not behave as expected.

    If you Google VBA error handling, you'll should find some good resources. Here's just a couple to get you started:

    Error Handling In VBA
    https://dl.dropboxusercontent.com/u/...r_Handling.pdf
    On Error WTF? | Excel Matters

  9. #9
    MrExcel MVP Rick Rothstein's Avatar
    Join Date
    Apr 2011
    Location
    New Jersey, USA
    Posts
    33,232
    Post Thanks / Like
    Mentioned
    59 Post(s)
    Tagged
    22 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Quote Originally Posted by eryksd View Post
    Yes, each column will have a header (1 cell with data)

    This new code seems to work well (runs in ~6 minutes across all sheets)
    Just out of curiosity, how fast does this code run for your data...
    Code:
    Sub DeleteEmptyColumns()
      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
      
      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 Application.CountA(WS.Columns(X)) = 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
    Last edited by Rick Rothstein; Feb 2nd, 2016 at 11:29 PM.
    Rick's "mini" blog... http://www.excelfox.com/forum/f22/
    .
    Want to post a small screen shot? See Part B here.

  10. #10
    Board Regular
    Join Date
    Jan 2016
    Posts
    51
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Using UNION and Ranges To Speed Up Deleting Many Columns?

    Quote Originally Posted by Rick Rothstein View Post
    Just out of curiosity, how fast does this code run for your data...
    Code:
    Sub DeleteEmptyColumns()
      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
      
      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 Application.CountA(WS.Columns(X)) = 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
    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

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •