VBA Delete empty columns within selection

[decadence]

Hi, How can I delete only empty columns within a selected range

This is the code I am using, It merges columns together based on string delimited input but I want to delete only the empty columns from the column selection, Can someone help with this please

Sub MergeColumns()
    Dim i As Long, addStr As String, a, b
        If Selection.Columns.count = 1 Then Exit Sub
        If Not Selection.Cells.CountLarge / Selection.Columns.count = 1048576 Then Exit Sub
[COLOR="#008000"]'Call Optimize_Begin[/COLOR]
    On Error Resume Next
    addStr = InputBox("Deliminate Columns By...", "Enter Deliminator...")
    If StrPtr(addStr) = 0 Then 
[COLOR="#008000"]'Call Optimize_End[/COLOR]
    Exit Sub
    End if
    With Intersect(ActiveSheet.UsedRange, Selection)
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        If addStr = addStr Then b(i, 1) = Join(Application.Index(a, i, 0), addStr)
    Next i
        .Value = b
    End With
[COLOR="#0000FF"]    Selection.Columns(1).Offset(0, 1).Delete[/COLOR] [COLOR="#008000"]<----- This needs changing[/COLOR]
[COLOR="#008000"]'Call Optimize_End[/COLOR]
End Sub

 

[Yongle]

Does this return correct result?

Selection.Offset(0, 1).Resize(, Selection.Columns.Count - 1).Delete Shift:=xlToLeft

 

[decadence]

Sorted it, For anyone that may need this code, also calling optimize codes are a separate code to speed up macro

Public Sub MergeColumns()
    Dim i As Long, addStr As String, a, b
        If Selection.Columns.count = 1 Then Exit Sub
        If Not Selection.Cells.CountLarge / Selection.Columns.count = 1048576 Then Exit Sub
Call Optimize_Begin
    On Error Resume Next
    addStr = InputBox("Deliminate Columns By...", "Enter Deliminator...")
        If StrPtr(addStr) = 0 Then
Call Optimize_End: Exit Sub
        End If
    With Intersect(ActiveSheet.UsedRange, Selection)
        a = .Value
        ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        If addStr = addStr Then b(i, 1) = Join(Application.Index(a, i, 0), addStr)
    Next i
        .Value = b
        .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete
        .Columns(1).EntireColumn.Select
    End With
Call Optimize_End
End Sub

Optimization Code, Put in separate module

Public CalcState As Long
Public EventState As Boolean
Public PageBreakState As Boolean

Sub Optimize_Begin()
'
    EventState = Application.EnableEvents
    CalcState = Application.Calculation
    PageBreakState = ActiveSheet.DisplayPageBreaks
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .Cursor = xlWait
    End With
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveSheet.DisplayPageBreaks = False
    ActiveSheet.UsedRange
End Sub

Sub Optimize_End()
'
    ActiveSheet.UsedRange
    ActiveSheet.DisplayPageBreaks = PageBreakState
    ActiveWindow.DisplayHorizontalScrollBar = True
    With Application
        .Cursor = xlDefault
        .Calculation = CalcState
        .ScreenUpdating = True
        .EnableEvents = EventState
    End With
End Sub

 

[Yongle]

Did you try my suggestion?

 

[decadence]

Thanks for the reply Yongle

 

[decadence]

Yes I did yongle and it works just as well, thanks

 

[Yongle]

Thanks for the feedback