Consulting

Results 1 to 8 of 8

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

  1. #1

    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
    -----------------------------------------
    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

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    try:
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  4. #4
    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

  5. #5
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    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
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  6. #6
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    2
    Location
    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:
    List = Sheets("to keep").Range("D166").Value

    To


    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





  7. #7
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    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
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #8
    VBAX Newbie
    Joined
    Jul 2019
    Posts
    2
    Location
    Oh great.

    P45 this works as intended.

    Thanks.

    ET

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •