Delete column numbers based on dynamic array population

[Viper147]

Good day everyone,
Been struggling on and off with this one for a few days now. It's an extract from a larger piece of code, but the only piece I cannot get to work as intended. The values in N1:P1 will be dynamic and will be matched against the values in A1:J1 (all of this was oversimplified just in order to get the process working after which I will transfer the logic to the original piece of code). If the values in the array in N1:P1 is not found in the range A1:J1 then the entire column in the range A1:J1 should be deleted. It deletes some of the columns but there are columns remaining afterwards that do not form part of the array. Been considering to rather add the column numbers to a new array and then delete the array instead of the current format, but not sure if that will solve the problem.
Anyway, below the code as it stands now.

Sub DeleteColumns()
    Dim VarArr As Variant
    a = Range("M1").Value
    
    VarArr = Array(Range(Cells(1, 14), Cells(1, 14 + a - 1)))
    Set TestRng = Range(Cells(1, 1), Cells(1, 10))
    For Each cell In TestRng
        If IsError(Application.Match(cell.Value, VarArr, 0)) Then
            cell.EntireColumn.Delete
        End If
    Next
End Sub

Any assistance is greatly appreciated.

 

[Jeffrey Mahoney]

Please try this. Deleting columns one at a time causes issues for the range you are evaluating. Deleting them after the evaluation works

Sub DeleteColumns()
    Dim VarArr As Variant
    Dim u As Range
    Dim Cel As Range
    Dim TestRng As Range
    
    a = Range("M1").Value
    
    VarArr = Array(Range(Cells(1, 14), Cells(1, 14 + a - 1)))
    Set TestRng = Range(Cells(1, 1), Cells(1, 10))
    For Each Cel In TestRng
        If IsError(Application.Match(cell.Value, VarArr, 0)) Then
            If Not u Is Nothing Then
              Set u = Union(u, Cel)
            Else
              Set u = Cel
            End If
        End If
    Next
    If Not u Is Nothing Then u.EntireColumn.Delete
End Sub

 

[Viper147]

Hi Jeffrey, thanks for the prompt assist, always a pleasure dealing with the guys on this forum. Tried the code you posted but got an error on the line marked in the code below. Tried changing from Variant to String but still getting an error. Also took the liberty of copying a snapshot of the test data that I am using for the code, not sure if this will help.

Sub DeleteColumns()
    Dim VarArr As Variant
    Dim u As Range
    Dim Cel As Range
    Dim TestRng As Range
    
    a = Range("M1").Value
    
    VarArr = Array(Range(Cells(1, 14), Cells(1, 14 + a - 1)))
    Set TestRng = Range(Cells(1, 1), Cells(1, 10))
    For Each Cel In TestRng
        If IsError(Application.Match(cell.Value, VarArr, 0)) Then 'Getting an Object required error on this line
            If Not u Is Nothing Then
              Set u = Union(u, Cel)
            Else
              Set u = Cel
            End If
        End If
    Next
    If Not u Is Nothing Then u.EntireColumn.Delete
End Sub

 

[Jeffrey Mahoney]

Dog gone it, I changed the variable to CEL and still had CELL on that line. Please try this

Sub DeleteColumns()
    Dim VarArr As Variant
    Dim u As Range
    Dim Cel As Range
    Dim TestRng As Range
    
    a = Range("M1").Value
    
    VarArr = Array(Range(Cells(1, 14), Cells(1, 14 + a - 1)))
    Set TestRng = Range(Cells(1, 1), Cells(1, 10))
    For Each Cel In TestRng
        If IsError(Application.Match(cel.Value, VarArr, 0)) Then 'Getting an Object required error on this line
            If Not u Is Nothing Then
              Set u = Union(u, Cel)
            Else
              Set u = Cel
            End If
        End If
    Next
    If Not u Is Nothing Then u.EntireColumn.Delete
End Sub

 

[Viper147]

Hi Jeffrey, apologies for the delay in responding. Didn't even spot that one myself. Thank you so much for the assist, works perfectly now.

 

[Viper147]

Just one last question, hopefully...
The columns I wish to delete span across a couple of sheets (structure all the same across the sheets). I amended the code you provided by amending the line

If Not u Is Nothing Then u.EntireColumn.Delete

to

If Not u Is Nothing Then
        For Each ws In NewBook.Sheets
            u.EntireColumn.Delete  'Getting an Object required error here
        Next ws

in order to achieve this. However, I get an Object required error on the line noted above. Thanks for the assist.

 

[Jeffrey Mahoney]

Ok, I don't have the ability to test. I think it's solid though

Sub DeleteColumns()
    Dim VarArr As Variant
    Dim u As Range
    Dim Cel As Range
    Dim TestRng As Range
    Dim Sht As Worksheet
    Dim CurSht As String
    Dim RowOnly As Range
    
    Set CurSht = ActiveSheet.Name
    a = Range("M1").Value
    
    Application.Calculation = xlCalculationManual
    
    VarArr = Array(Range(Cells(1, 14), Cells(1, 14 + a - 1)))
    Set TestRng = Range(Cells(1, 1), Cells(1, 10))
    For Each Cel In TestRng
        If IsError(Application.Match(Cel.Value, VarArr, 0)) Then 'Getting an Object required error on this line
            If Not u Is Nothing Then
              Set u = Union(u, Cel)
            Else
              Set u = Cel
            End If
        End If
    Next
    If Not u Is Nothing Then
      u.EntireColumn.Delete
      Set RowOnly = u.Resize(1)                           'One row of range u
    Else
      Exit Sub
    End If
    
    For Each Sht In ThisWorkbook.Worksheets
      If Sht.Name <> CurSht Then                            'Not the sheet above
        Select Case Sht.Name
          Case "Sheet22", "Sheet23", "Sheet24"              'Only selected sheets; change as needed
            Set u = Nothing
            For Each Cel In RowOnly                         'One row of u
              If Not u Is Nothing Then
                Set u = Union(u, Sht.Cells(1, Cel.Column))  'Column on new sheet
              Else
                Set u = Sht.Cells(1, Cel.Column)
              End If
            Next Cel
            u.EntireColumn.Delete                           'Delete same columns on new sheet
        End Select
      End If
    Next Sht
    
    Application.Calculation = xlCalculationAutomatic
    
End Sub

 

[Viper147]

Thanks, all good now. Thank you for all your help.