1

I'm brand new to VBA coding and I am trying to get the below code to execute it's function without having to run it multiple times.

The function deletes the columns equal to the text in the array however I need to run it 2-3 times to before it will remove all the columns.

Sub DeleteSpecifcColumn()
    Dim xFNum, xFFNum, xCount As Integer
    Dim xStr As String
    Dim xArrName As Variant
    Dim MR, xRg As Range
    On Error Resume Next
    Set MR = Range("A1:N1")
    xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9",    "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")
    xCount = MR.Count
    xStr = xArrName(xFNum)
    For xFFNum = xCount To 1 Step -1
        Set xRg = MR(1, xFFNum)
        For xFNum = 0 To UBound(xArrName)
            xStr = xArrName(xFNum)
            If xRg.Value = xStr Then xRg.EntireColumn.Delete
        Next xFNum
    Next
End Sub

Having the same issues with the below function:

Sub change_header_2()
    Cells(1, "A").Value = "Shift"
    Cells(1, "B").Value = "Clock In Time"
    Cells(1, "C").Value = "First Task"
    Cells(1, "D").Value = "Last Task"
    Cells(1, "E").Value = "Clock Out"
    Cells(1, "F").Value = "User"
    Cells(1, "G").Value = "Name"
End Sub

Any help would be much appreciated

Attempted to run a loop to get past the issue but I don't know how to write that into the sub or how to write it into a new sub that runs the loop of the previous sub

Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • 2
    I suggest you dramatically simplify this by just looping through `xArrName`. For each element use an Excel `Find` method to find the cell in row one that contains this name. If something is found, delete it. As is, the code looks very complicated. Also I recommend you do some code indentation in any loops you code. Last of all *NEVER EVER* use `On Error Resume Next` - I suggest you remove it – Nick.Mc Jul 19 '23 at 01:47
  • 4
    "NEVER EVER use On Error Resume Next" - unless you know exactly how it works, and you're OK with the following code possibly silently breaking, and you know exactly what the consequences of that would be. – Tim Williams Jul 19 '23 at 01:55
  • 1
    I am afraid that the ActiveSheet is not always the one, where you want to delete the columns. If you want to be sure of it use: Set MR = Worksheets("the name where delete").Range("A1:N1") – Black cat Jul 19 '23 at 04:18
  • 1
    Also note, that `Dim MR, xRg As Range` only declares `xRg As Range` but `MR` will be of type `Variant`. In VBA you need to specify a type for **every** variable otherwise it always is `Variant` by default: `Dim MR As Range, xRg As Range`. Same with `Dim xFNum, xFFNum, xCount As Integer` and I recommend to use `Long` instead of `Integer` Excel has more rows/cells than fit into `Integer` also see [this](https://stackoverflow.com/questions/26409117/why-use-integer-instead-of-long/26409520#26409520). – Pᴇʜ Jul 19 '23 at 06:35

4 Answers4

1

Delete Matching Columns

Sub DeleteMatchingColumns()
    
    Const HEADER_RANGE As String = "A1:N1"
    Dim LookupHeaders(): LookupHeaders = Array( _
        "textBox1", "textBox3", "textBox4", "textBox5", "textBox6", _
        "1textBox7", "textBox8", "textBox9", "textBox10", "textBox11", _
        "textBox12", "textBox14", "textBox19", "textBox22", "textBox23", _
        "textBox24", "textBox25")
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim hrg As Range: Set hrg = ws.Range(HEADER_RANGE).Rows(1) ' ensure one row
    Dim hcCount As Long: hcCount = hrg.Columns.Count
    
    ' In this case, 'hcIndexes' will return a 1D one-based array
    ' containing the indexes of matches or error values if not matching.
    Dim hcIndexes()
    
    If hcCount = 1 Then ' one column of headers
        ReDim hcIndexes(1 To 1)
        hcIndexes(1) = Application.Match(CStr(hrg.Value), LookupHeaders, 0)
    Else ' multiple columns of headers
        hcIndexes = Application.Match(hrg, LookupHeaders, 0)
    End If
    
    Dim hurg As Range, hc As Long
    
    For hc = 1 To hcCount
        If IsNumeric(hcIndexes(hc)) Then ' it's a match
            ' Combine the matching cells into a range.
            If hurg Is Nothing Then
                Set hurg = hrg.Cells(hc)
            Else
                Set hurg = Union(hurg, hrg.Cells(hc))
            End If
        'Else ' it's not a match; do nothing
        End If
    Next hc
        
    If hurg Is Nothing Then
        MsgBox "No matches found.", vbExclamation
    Else
        ' Delete all matching columns in one go.
        hurg.EntireColumn.Delete xlShiftToLeft
        MsgBox "Columns deleted.", vbInformation
    End If
        
End Sub
VBasic2008
  • 44,888
  • 5
  • 17
  • 28
0

Here are two workarounds for the first sub.

#1 - Looping through range and array

'declare Worksheet variable to hold the exact sheet - ActiveSheet 
is a quite random value
Dim ws As Worksheet

' declare and fill array
Dim xArrName As Variant
xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")

' declare a range to search values in
Dim workRange As Range

' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")

' declare iteration variable for columns - it's a good practice to
' grant variables with explanatory names
Dim columnIterator As Integer

'same for array iterator
Dim arrayIterator As Integer

' in case you want to loop through both array and range
' looping through range
For columnIterator = 14 To 1 Step -1
    ' looping through array
    For arrayIterator = LBound(xArrName) To UBound(xArrName)
        If ws.Cells(1, columnIterator).Value = xArrName(arrayIterator) Then
            ws.Cells(1, columnIterator).EntireColumn.Delete
        End If
    Next
Next
' do other stuff

#2 - Using the '.Find()' method

'declare Worksheet variable to hold the exact sheet - ActiveSheet is a quite random value
Dim ws As Worksheet

' declare and fill array
Dim xArrName As Variant
xArrName = Array("textBox25", "textBox4", "textBox6", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23", "textBox5", "textBox7", "textBox24", "textBox1", "textBox3", "textBox14", "textBox8", "textBox19", "textBox9", "textBox10", "textBox11", "textBox22", "textBox12", "textBox23")

' declare a range to search values in
Dim workRange As Range

' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")

' assign a range with binding to specific sheet
Set workRange = Range(ws.Cells(1, 1), ws.Cells(1, 14))
' that's just for looping through array
' like Nick.McDermaid suggestet
For arrayIterator = LBound(xArrName) To UBound(xArrName)
' in this case I DO know that if there
' will be no matches on .Find() function
' I will get an
' Run-time error '91': Object variable or With block variable not set
' error and can live with that for now
' so I use On Error Resume Next statement to ignore it
On Error Resume Next
    workRange.Find(xArrName(arrayIterator)).EntireColumn.Delete
Next

' reset error handler after the loop
Err.Clear

' do other stuff

These approaches will work fine in case you dont have any values after the 'N' column (O, P, Q, R... etc), otherwise, those values will shift left and range "A1:N1" may contain deleted values again.

And this is for second sub, try using specific sheet and cells on it to set values

Sub change_header_2()
'declare Worksheet variable to hold the exact sheet - ActiveSheet is a 
quite random value
Dim ws As Worksheet
' assign a specific sheet to variable, you may need to change the sheet name
Set ws = ThisWorkbook.Sheets("Sheet1")

' this construction will add values
' to specific cells on a specific sheet
With ws
    .Cells(1, "A").Value = "Shift"
    .Cells(1, "B").Value = "Clock In Time"
    .Cells(1, "C").Value = "First Task"
    .Cells(1, "D").Value = "Last Task"
    .Cells(1, "E").Value = "Clock Out"
    .Cells(1, "F").Value = "User"
    .Cells(1, "G").Value = "Name"
End With
End Sub

And finally you should pay attention to Pᴇʜ's comment regarding variables declaration.

Vitaliy Prushak
  • 1,057
  • 8
  • 13
0

I don't include any code, because your code is working, but only in special circumstances. These are.

  • The references without an object qualifier refer to a sheet according to the followings

    1. Placed in a sheet's code: Refers to the sheet where it is placed
    2. Placed in ThisWorkbook or Module: Refers to the ActiveSheet.
    
  • With defined object qualifier refers to the Object what is defined.

In the code with the Me keyword you can reach the sheet where the code is running, but take care of it, because Microsoft not define it explicitly. For further infos see from Microsoft

https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/me-keyword

In your code therefore add the Worksheet name before the Range and Cells properties in this form

Worksheets("name").

where name is the actual name of the sheet given on the Tab at the bottom of the window.

Black cat
  • 1,056
  • 1
  • 2
  • 11
0

A few things seem to be going on here. I'm interested in why you need to run your code multiples times to get all of the columns deleted. It looks to me like your Set MR = Range("A1:N1") might have something to do with it. That range contains 14 members, but you're trying to detect 25 column titles to delete.

Also, when declaring multiple variables of the same type, you still need to declare their types. For example, Dim MR, xRg As Range does NOT declare those two as Ranges, rather it declares xRg as a Range and it declares MR as a Variant which is the datatype that VBA uses when no other is specified. What you would like here is Dim MR As Range, xRg As Range.

Here is a paired down version of what you want to do, as an example:

Private Sub DeleteColumns()

    ' Range of cells to look through
    Dim HeaderRange As Range
    Set HeaderRange = Range("A1:N1")
    
    ' Column names we want to delete
    Dim BadNames As Variant
    BadNames = Array("textBox3", "textBox5")
    
    ' Iterate through our range of cells, looking at column names
    Dim ii As Long, jj As Long
    For ii = HeaderRange.Columns.Count To 1 Step -1
        
        ' For each cell in the range, compare its name to the Bad names
        For jj = LBound(BadNames) To UBound(BadNames)
        
            ' If the name is one of the Bad names, delete the column
            If HeaderRange(ii).Value = BadNames(jj) Then
                HeaderRange.Columns(ii).EntireColumn.Delete
                
                ' We can exit the "jj" loop now, because we've already
                ' deleted the column
                Exit For
                
            End If
            
        Next jj
        
    Next ii

End Sub

This should be enough to guide you. You could also think about turning this into a Sub that takes the range of header cells and a list of bad names as arguments, if this is a task you expect to do regularly.

TehDrunkSailor
  • 633
  • 4
  • 11