VBA Selecting Multiple Noncontiguous Table Columns by Name

Question

This following code works, but it needs to be simplified so that the table columns are deleted with one line of code if possible. The columns are noncontiguous and are downloaded straight from a website that supplies the data, so I can only work with what I'm given each time I download the data.

Sub dataSort()
    
    ActiveSheet.ListObjects.Add(xlSrcRange, _
                                Range([A1].End(xlDown), [A1].End(xlToRight)), _
                                , xlYes).Name = "dataSort"
    
    Range("dataSort[Vortex ID]").Delete
    Range("dataSort[Lead Status]").Delete
    Range("dataSort[Listing Status]").Delete
    Range("dataSort[Address]").Delete
    Range("dataSort[Mailing City]").Delete
    Range("dataSort[Mailing State]").Delete
    Range("dataSort[Mailing Zip]").Delete
    Range("dataSort[List Price]").Delete
    Range("dataSort[Lead Date]").Delete
    Range("dataSort[Status Date]").Delete
    Range("dataSort[Type]").Delete
    Range("dataSort[Lot Size]").Delete
    Range("dataSort[Phone Counter]").Delete
    Range("dataSort[Email Counter]").Delete
    Range("dataSort[Mail Counter]").Delete
    Range("dataSort[House Number]").Delete
    Range("dataSort[Tax ID]").Delete
    
End Sub

Answer 1

Delete Excel Table Columns By Title

Sub CleanData()
    
    Const TABLE_NAME As String = "DataSort"
    Dim ColumnTitles() As Variant: ColumnTitles = Array( _
        "Vortex ID", "Lead Status", "Listing Status", "Address", _
        "Mailing City", "Mailing State", "Mailing Zip", "List Price", _
        "Lead Date", "Status Date", "Type", "Lot Size", _
        "Phone Counter", "Email Counter", "Mail Counter", "House Number", _
        "Tax ID")
    
    Dim ws As Worksheet: Set ws = ActiveSheet
    Dim lo As ListObject: Set lo = ws.ListObjects.Add(xlSrcRange, _
        ws.Range("A1").CurrentRegion, , xlYes)
    lo.Name = TABLE_NAME
     
    Dim urg As Range, crg As Range, n As Long
    
    For n = LBound(ColumnTitles) To UBound(ColumnTitles)
        On Error Resume Next ' prevent error if column doesn't exist
            Set crg = lo.ListColumns(ColumnTitles(n)).Range
        On Error GoTo 0
        If Not crg Is Nothing Then ' column exists
            If urg Is Nothing Then Set urg = crg Else Set urg = Union(urg, crg)
            Set crg = Nothing ' reset for the next iteration
        End If
    Next n

    If Not urg Is Nothing Then urg.Delete Shift:=xlShiftToLeft

End Sub

Answer 2

Sub Makro1()
With ActiveSheet.ListObjects.Add(xlSrcRange, Range([A1].End(xlDown), [A1].End(xlToRight)), , xlYes)
    .Name = "dataSort"
    For Each S In Array("Vortex ID", "Lead Status", "Listing Status", "Address")
        .ListColumns(S).Delete
    Next
End With

End Sub