Home > Back-end >  Excel VBA applied to selected columns and delete all the other columns in that worksheet
Excel VBA applied to selected columns and delete all the other columns in that worksheet

Time:08-24

I have two columns C and DK and code to select them

Application.Union(Range("C1"), Range("DK1")).EntireColumn.Select

I want to work in the same worksheet say "Dashboard" not to create a new one and delete all the other (not selected) columns in that sheet.

CodePudding user response:

Solution

Sub DeleteAllOtherColumns()

    Dim myColumns  As Range
    Dim delColumns As Range
    Dim headerRow  As Range
    Dim headerCell As Range
    Dim Ws         As Worksheet
    
    Set Ws = Worksheets("Dashboard")
    Set myColumns = Ws.Range("C1,DK1")
    Set headerRow = Ws.Range(Cells(1, 1), Cells(1, GetLastColumn(Ws)))
    
    For Each headerCell In headerRow.Cells
        If Application.Intersect(headerCell, myColumns) Is Nothing Then
            Set delColumns = RngUnion(delColumns, headerCell)
        End If
    Next
    
    If Not delColumns Is Nothing Then
        delColumns.EntireColumn.Delete
    End If
    
    MsgBox "Done!"
End Sub

Private Function GetLastColumn(Optional TargetSheet As Worksheet) As Long
    If TargetSheet Is Nothing Then Set TargetSheet = ActiveSheet
    On Error Resume Next
    With TargetSheet
        GetLastColumn = .Cells.Find( _
            what:="*", _
            After:=.Range("A1"), _
            SearchOrder:=xlByColumns, _
            SearchDirection:=xlPrevious).Column
    End With
    If GetLastColumn = 0 Then GetLastColumn = 1
End Function

Private Function RngUnion(Rng1 As Range, Rng2 As Range) As Range
    If Rng2 Is Nothing Then Err.Raise 91 ' Object variable not set
    If Rng1 Is Nothing Then
        Set RngUnion = Rng2
        Exit Function
    End If
    Set RngUnion = Union(Rng1, Rng2)
End Function
  • Related