Delete entire blank columns-CodePudding

Need to delete blank columns in a worksheet. I need the whole column delete sho it move the imported columns with text into in to be at the start of the sheet. The placement of the columns with text in them will change weekly so I need something that can delete full columns until the last text column. Code I was trying is listed below.

Sub Delete_Columns
 C = ActiveSheet.Cells.SpecialCells(xlLastCell).Column
   Do Until C = 0
   If WorksheetFunction.CountA(Columns(C)) = 0 Then
   Columns(C).Delete
   End If
   C = C - 1
   Loop
End Sub

CodePudding user response：

Delete Blank Columns

Option Explicit

Sub DeleteBlankColumns()
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim rg As Range: Set rg = ws.UsedRange
    Dim rCount As Long: rCount = rg.Rows.Count
    
    Dim dcrg As Range
    Dim crg As Range
    
    For Each crg In rg.Columns
        If Application.CountBlank(crg) = rCount Then
            If dcrg Is Nothing Then
                Set dcrg = crg
            Else
                Set dcrg = Union(dcrg, crg)
            End If
        End If
    Next crg
    If dcrg Is Nothing Then Exit Sub
       
    dcrg.EntireColumn.Delete
    
End Sub