删除空白列以使用excel-vba创建数据透视表

Question

I'm trying to automate the generation of a pivot table for a report I have to write at work. When I import data into excel the data has these extra columns with no information in them. As you probably know, Excel will not create pivot tables when there are extra columsn. Is there a script that can delete the columns that have no data?

A VBA solution is preferable.

Answer 1

Try this ( TRIED AND TESTED )

Sub Sample()
    Dim LastCol As Long
    Dim i As Long

    LastCol = Sheets("Sheet1").Cells.Find(What:="*", _
              After:=Sheets("Sheet1").Range("A1"), _
              Lookat:=xlPart, _
              LookIn:=xlFormulas, _
              SearchOrder:=xlByColumns, _
              SearchDirection:=xlPrevious, _
              MatchCase:=False).Column

    For i = LastCol To 1 Step -1
        If Application.WorksheetFunction.CountA(Sheets("Sheet1").Columns(i)) = 0 Then _
        Sheets("Sheet1").Columns(i).Delete
    Next i
End Sub

FOLLOWUP

I would recommend Adam's way (It is more efficient) for preparing the data for Pivot as per your requirements. My code will fail if there is a blank cell which has a space. You might want to use

Len(Trim(ws.Cells(start_row, col).Value)) = 0

in lieu of

ws.Cells(start_row, col).Value = ""

in Adam's code.

If you are sure that there will be no blank space then you can use my code as well :)

Sid

Answer 2

This should be more efficient than @Siddharth's answer because it only checks the first row. (But he beat me by many minutes, so +1 to him!)
Since we know that when there is no column heading, Excel will not allow a pivot table to be created.

Option Explicit

Sub prepare_for_pivot()
    Dim ws As Worksheet
    Dim last_col As Long
    Dim start_row As Long
    Dim col As Long
    Set ws = ThisWorkbook.Sheets(1)

    start_row = 1
    last_col = ws.Cells(start_row, ws.Columns.Count).End(xlToLeft).Column

    For col = last_col To 1 Step -1
        If ws.Cells(start_row, col).Value = "" Then
            ws.Columns(col).EntireColumn.Delete
        End If
    Next col
End Sub