Code To Delete Columns Containing No Data

[Dazzawm]

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]

=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]

Try:

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

 

[Dazzawm]

Thanks mumps, works great.

 

[mumps]

My pleasure.

 

[Dazzawm]

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?

 

[mumps]

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]

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?

 

[mumps]

Can you post the Trim code you are using?

 

[Dazzawm]

Can you post the Trim code you are using?

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