PDA

View Full Version : Delete columns in spreadsheet based on list of column names specified in listed range



YodaMaster
06-13-2019, 12:40 PM
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

Paul_Hossler
06-13-2019, 01:01 PM
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

p45cal
06-13-2019, 01:37 PM
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

YodaMaster
06-14-2019, 02:50 AM
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

Paul_Hossler
06-14-2019, 05:10 AM
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

Area51
07-17-2019, 09:53 AM
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("D1:D66").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

p45cal
07-17-2019, 12:46 PM
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

Area51
07-18-2019, 08:15 AM
Oh great.

P45 this works as intended.

Thanks.

ET