0

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.

Michael W
  • 45
  • 5
  • So... what's the problem? Side note: in general, you want to [avoid using select in your code](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) – cybernetic.nomad Aug 22 '22 at 16:35
  • It only highlights the selected columns and keep the others as well. I want to delete the rest without creating a new worksheet. – Michael W Aug 23 '22 at 08:23

1 Answers1

0

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
stanislavsabev
  • 41
  • 5
  • What if the name of the Worksheet changes? There is a loop in my code before and with every iteration it changes to "Dashboard_" & Date – Michael W Aug 23 '22 at 10:22
  • There are various ways to do it. You can change the code line to `Worksheets("Dashboard" & Format(Date, ""))`. But then it will only work for the current day sheet. Best is to create a config cell with formula like this one `="Dashboard_"&TEXT(TODAY(), "YYYY-mm-dd")`. Let's say the cell is `A2` in Sheet called `Config` - in the code replace `Worksheets("Dashboard")` with `Worksheets(Worksheets("Config").Range("A2").Value)`. This should work and you will be able to change the cell to your liking. Hope this helps! – stanislavsabev Aug 23 '22 at 13:57
  • I applied it as: `Ws = ActiveWorkbook.Worksheets("Dashboard_" & CurrentDate)` I have an error message in the line `Set RngUnion = Union(Rng1, Rng2)` Error: `1004, method Union of Object Global Failed` – Michael W Aug 23 '22 at 14:28
  • 1. Try to change the line to this `Excel.Union(..`. 2. What version of Excel and how many header cells are in your Sheet? – stanislavsabev Aug 23 '22 at 14:47