Code To Delete Columns Containing No Data

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
I have a massive file, several thousand rows by about 50 columns. Is there a code I can run that will delete all columns that contain no data below header row 2. Otherwise I will have to sort each column individually which will take ages. Thanks.
 

oldbrewer

Board Regular
Joined
Apr 11, 2010
Messages
10,988
=counta(c3:c5000) will return 0 if the column is empty apart from the C1 and C2

so insert a new row at the top and in C1 =counta(c4:c5000)

copy across

wherever there is a zero in row 1 delete the whole column

5 minutes max !!!!
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,615
Try:
Code:
Sub DelCols()
    Application.ScreenUpdating = False
    Dim lCol As Long
    lCol = ActiveSheet.UsedRange.Columns.Count
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim x As Long
    For x = lCol To 1 Step -1
        If WorksheetFunction.CountA(Range(Cells(3, x), Cells(LastRow + 1, x))) = 0 Then
            Columns(x).EntireColumn.Delete
        End If
    Next x
End Sub
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,615
My pleasure. :)
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
I have gone to use this mumps and nothing happens. I know it's been a few months since you did this but what do you think is the problem. I know there are certain columns with no data in but it is not deleting them. Could it be one of those cases that although the cells look empty there could be something in there? Would some sort of trim formula in the code help?
 
Last edited:

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,615
It is always easier to help and test possible solutions if we could work with your actual file. Perhaps you could upload a copy of your file to a free site such as www.box.com. or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Include a detailed explanation of what you would like to do referring to specific cells and worksheets. If the workbook contains confidential information, you could replace it with generic data.
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
I have got it to work. I did use a trim code that I had on the file and run your code again and it worked. So do you think you could add a trim code into the code you did for me or shall I just run it manually should I get anymore problems?
 

Dazzawm

Well-known Member
Joined
Jan 24, 2011
Messages
3,379
Can you post the Trim code you are using?
Code:
Sub TrimALL()
       Application.DisplayAlerts = True
      Application.EnableEvents = True   'should be part of Change Event macro
   If Application.Calculation = xlCalculationManual Then
      MsgBox "Calculation was OFF will be turned ON upon completion"
   End If
   Application.Calculation = xlCalculationManual
   Dim Cell As Range
   'Also Treat CHR 0160, as a space (CHR 032)
   Selection.Replace What:=Chr(160), Replacement:=Chr(32), _
     LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   'Trim in Excel removes extra internal spaces, VBA does not
   On Error Resume Next   'in case no text cells in selection
   For Each Cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
     Cell.Value = Application.Trim(Cell.Value)
   Next Cell
   On Error GoTo 0
   Application.Calculation = xlCalculationAutomatic
   End Sub
 

Forum statistics

Threads
1,085,703
Messages
5,385,313
Members
401,938
Latest member
JustinTaster

Some videos you may like

This Week's Hot Topics

Top