Loop through column titles (1st row) if name is in array

[FuNeS13]

I know I'm doing something wrong in this part of the code, but I don't know what...

Dim MyArray As Variant
Dim found As Boolean
Dim uB As Integer, lB As Integer
Dim LC As Long

MyArray = Array("Type", "Number", "Order", "Invoice Date", "Due/Paid Date", "Amount", "Shipment", "Customer", "Name", "Credit Limit", "Chk/Ref")
LC = Cells(1, Columns.Count).End(xlToLeft).Column '56 columns
     uB = UBound(MyArray)
    lB = LBound(MyArray)
c = 1

For i = lB To uB
        Do Until c = LC + 1
                If Range(Split(Cells(1, c).Address, "$")(1) & "1").Value = MyArray(i) Then
                    found = True
                Else
                    found = False
                End If
                
                If found = False Then
                    Range(Split(Cells(1, c).Address, "$")(1) & ":" & Split(Cells(1, c).Address, "$")(1)).Select
                    Selection.Delete Shift:=xlToLeft
                Else
                GoTo nexti
                End If
        c = c + 1
        Loop
nexti:
Next i

what I want to do is if the titles on the first row exist in my array list, then I want to keep that column, if it doesn't exist then I want the column to be removed...

 

[FuNeS13]

Another way is to iterate through each cell in row 1, use the MATCH function to check for existence in MyArray. If it doesn't exist, change the value to an "error".
Then, use SpecialCells to highlight the column, and afterwards perform a single delete operation (in the code, use .select for verification, and if it's fine, replace it with .delete).

Dim LC As Long, myArray, ce As Range
LC = Cells(1, Columns.Count).End(xlToLeft).Column
myArray = Array("Type", "Number", "Order", "Invoice Date", "Due/Paid Date", "Amount", "Shipment", "Customer", "Name", "Credit Limit", "Chk/Ref")
For Each ce In Range("A1", Cells(1, LC))
    If Not IsNumeric(Application.Match(ce, myArray, 0)) Then
        ce.Value = "#N/A"
    End If
Next
Range("A1", Cells(1, LC)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Select
'Range("A1", Cells(1, LC)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete

thank you, I also tried this solution and it worked as expected... I think your approach I understand a bit more than the previous one.

 

[bebo021999]

Nice to hear it works.

Let me break down the provided VBA code step by step:

Dim LC As Long, myArray, ce As Range

This line declares variables LC, myArray, and ce of type Long, Variant, and Range respectively.

LC = Cells(1, Columns.Count).End(xlToLeft).Column

Here, it calculates the last used column in the first row by finding the rightmost cell that contains data (by going from the last column towards the left) using the xlToLeft parameter.

myArray = Array("Type", "Number", "Order", "Invoice Date", "Due/Paid Date", "Amount", "Shipment", "Customer", "Name", "Credit Limit", "Chk/Ref")

An array named myArray is created and filled with specific strings that will be used later for comparison.

For Each ce In Range("A1", Cells(1, LC))

This initiates a loop that goes through each cell in the range starting from cell A1 to the last cell in the first row (determined by the LC value calculated earlier). The loop variable ce represents each cell in this range.

If Not IsNumeric(Application.Match(ce, myArray, 0)) Then
ce.Value = "#N/A"
End If

For each cell in the range, it uses the Application.Match function to see if the value in that cell exists in the myArray. If it doesn't find a match (indicated by IsNumeric(Application.Match(ce, myArray, 0)) being False), it replaces the value in that cell with "#N/A".

Range("A1", Cells(1, LC)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Select
'Range("A1", Cells(1, LC)).SpecialCells(xlCellTypeConstants, xlErrors).EntireColumn.Delete

This line selects the entire columns that have constant (non-formula) values with errors (in this case, the cells that were previously changed to "#N/A"). The second line, which is commented out, would delete these selected columns. However, as indicated by the comment, it's currently commented out. To perform the deletion, you would uncomment this line.

 

[Akuini]

thanks, this worked exactly as I was expecting it... would you mind explaining it a little bit to me?

I added some comments:

Sub FuNeS13()

Dim c As Range, f As Range
Dim myHeader As String
'put the headers to keep, each is enclosed in pipe
myHeader = "|Type|Number|Order|Invoice Date|Due/Paid Date|Amount|Shipment|Customer|Name|Credit Limit|Chk/Ref|"

For Each f In Range("A1", Cells(1, Columns.Count).End(xlToLeft))  'loop each cell in row 1 until last column  with data
                                                                  'vbTextCompare means it's case insensitive
    If InStr(1, myHeader, "|" & f.Value & "|", vbTextCompare) = 0 Then 'if the cell value (enclosed in pipe) is not found in myHeader
        If Not c Is Nothing Then
            Set c = Union(c, f) 'combine cells/range that meet criteria to delete
        Else
            Set c = f 'the first cell that meet criteria to delete
        End If
    End If
Next

c.EntireColumn.Delete 'delete whole column of cells/range that meet criteria to delete

End Sub