Delete columns in spreadsheet based on list of column names specified in listed range

Hi

I have the code below that runs fine. It deletes all columns in a spreadsheet (sheet("Data")) that are not contained in the case statement. However instead of specifying the columns not to delete within the vba case statement code every time, I would like to read the columns from a range listed in a spreadsheet instead, e.g in another sheet.

I've tried to do it using a range reference but it does not work.

Setup as follows.

a) Data to delete is in the following sheet:

Sheets("Data")

To loop from column 29 to last as per current code. The column headers are in row 1:

b) List column names not to delete are listed here (instead of the code):

headerstodelete = Sheets("ColDeletionList").Range ("A2:A50").value

Thanks

Yoda

Code:

---

Sub deleteIrrelevantColumns()
Dim currentColumn As Integer
Dim columnHeading As String
' ActiveSheet.Columns("G").Delete
' List = Sheets("to keep").Range("D1:D30")
currentColumn = 5
For currentColumn = ActiveSheet.UsedRange.Columns.Count To 29 Step -1  ' start from last col to 29 onwards only
columnHeading = ActiveSheet.UsedRange.Cells(1, currentColumn).Value
    'CHECK WHETHER TO KEEP THE COLUMN
    Select Case columnHeading
        ' Insert list reference here instead of specifying in code
        ' headerstodelete
        Case "Acq_WK_1", "Acq_WK_20", "Acq_WK_34", "Area_Hemel_Hempstead", "Area_Reading", "Area_South_West_London", "ctype_guest", "email", "fo_Category_KNITWEAR", _
        "fo_Category_OUTERWEAR", "fo_Category_WOVEN", "fo_Category_WOVEN_TROUSERS", "fo_device_mobile", "fo_discount_dummy", "fo_discountandfreedelivery_dummy", _
        "fo_discountrate", "fo_freedelivery_dummy", "fo_Mth_Aug", "fo_part_returner_dummy", "fo_total_discountorderstable", "fo_totalvalue", "fo_visit_cpc", "fo_visit_display", _
        "fo_visit_email", "Forecast", "mailedbook_andy", "multi_order_customer", "recency_dayssincelastorder", "visits", "gets_email_andyandnotsubscribed", "Acq_MTH_1", "Acq_MTH_10", _
        "Acq_MTH_11", "Acq_MTH_3", "Acq_MTH_4", "Acq_MTH_5", "Acq_MTH_6", "Acq_MTH_9", "Acq_WK_10", "Acq_WK_16", "Acq_WK_19", "Acq_WK_40", "acquisition_year", _
        "age_missing_dummy", "age_nullsreplavg", "Area_Aberdeen", "Area_Guildford", "Area_North_London", "Area_Redhill", "Area_South_West_London", "Area_West_London", _
        "cold_book_redeem", "ctype_customer", "ctype_guest", "ctype_prospect", "gender_missing_dummy", "gendermale_dummy", "gets_email_andy", "households_avg_repzero", _
        "location_london", "mailedbook_andy", "no_postcode_dummy", "population_avg_repzero", "propensityscore_andy", "unsubscribed_from_email", "visits"
            'Do nothing
        Case Else
            'Delete if the cell doesn't contain "Homer"
            If InStr(1, ActiveSheet.UsedRange.Cells(1, currentColumn).Value, "Homer", vbBinaryCompare) = 0 Then
                ActiveSheet.Columns(currentColumn).Delete
            End If
    End Select
Next
End Sub

---

It'd be a lot easier to help if you could attach a small workbook

Also it might be useful to allow wildcards in the 'Keep' list, i.e. "Acq_MTH_*" to catch them all

try:

Code:

---

Sub deleteIrrelevantColumns2()
List = Sheets("to keep").Range("D1:D66").Value 'adjust this range's size.
Set RowOne = ActiveSheet.UsedRange.Rows(1)
For i = RowOne.Cells.Count To 29 Step -1
  cc = Application.Match(RowOne.Cells(i).Value, List, 0)
  If IsError(cc) Then
    If InStr(1, RowOne.Cells(i).Value, "Homer", vbBinaryCompare) = 0 Then RowOne.Cells(i).EntireColumn.Delete
  End If
Next i
End Sub

---

Thanks P45.

I've tested the code and it seems to runs fine. And it's shorter as well so great stuff.

Paul - Wildcard search sounds awesome but trying to think in what circumstances other than not knowing the exact names of the columns I want to delete, would it be useful. Did you mean in this context or something else?

Thanks

Master but not of VBA

I was just thinking ... your example has a long list to keep, and an InStr to delete -- what if there is a sheet with a name NOT on the list, but also NOT contraining Homer?

Say you add a WK_ACQ_5 sheet, but forget to add it to the list

A wildcard like Keep "WK_ACQ_*" on the list would automatically keep it

Hi All

In terms of the columns to delete list (List array), is there a way to populate it using a selection inputbox where the user selects a range in a column containing the column header names, e,.g D1 to D11)

For example, change:

Code:

---

List = Sheets("to keep").Range("D1:D66").Value

---

To

Code:

---

Dim inputrange As Range
Set inputrange
 = Application.InputBox(prompt:="Please select any cell", Type:=8)
List= Inputrange

---

List should now return the names of 11 columns headers that should be deleted in the next step

Thanks

Alien Hideaway

Code:

---

Sub deleteIrrelevantColumns2()
Dim inputrange As Range
On Error Resume Next
Set inputrange = Application.InputBox(prompt:="Please select any cell", Type:=8)
On Error GoTo 0
If inputrange Is Nothing Then
  MsgBox "Aborted"
Else
  List = inputrange.Value
  If Not IsArray(List) Then List = Array(List)
  'List = Sheets("to keep").Range("D1:D66").Value 'adjust this range's size.
  Set RowOne = ActiveSheet.UsedRange.Rows(1)
  For i = RowOne.Cells.Count To 29 Step -1
    cc = Application.Match(RowOne.Cells(i).Value, List, 0)
    If IsError(cc) Then
      If InStr(1, RowOne.Cells(i).Value, "Homer", vbBinaryCompare) = 0 Then RowOne.Cells(i).EntireColumn.Delete
    End If
  Next i
End If
End Sub

---

Oh great.

P45 this works as intended.

Thanks.

ET