I have a Specification document in which there are a list of columns I have to put out in my report document. The sheet where all the data is given to me, has a lot of columns (not all of them are relevant) and I want to hide/delete these columns (I receive a new doc every day, so is not critical for me to delete those columns)
I have in another sheet, named "column_names" all the headers of the columns i need.
But I don't know how to filter the sheet to hide/delete those columns.
Has anyone an idea how to filter it ?
The function I found (autofilter) filter the rows with a criteria, but no the columns.
CodePudding user response：
Assuming the data in your "Specification document" are set out as columns like this:
and assuming your target data are set out like this:
then the code below should work for you. Using the example images above, this script will delete or hide columns A, C, and G through I. The script uses vbBinaryCompare, so your headings will need to be an exact match. Differences in case, extra whitespace, etc., could all throw it off. Headings that don't match exactly are deleted/hidden.
It's probably best if you paste the script into a fresh Excel file, not the spec doc and not the target daily doc, otherwise you could run into file-lock issues. There's no error catching built-in, so that's on you if you want it.
If you want to do a test run to see how it works, you can comment out the following two lines near the end of the script. Commenting out these lines makes it so that you can review the target/daily file and, if you don't like the changes the script made, simply close the workbook without saving.
'wbTargetWorkbook.Save
'wbTargetWorkbook.Close
This script will first prompt you to decide whether you want to delete the columns or merely hide them. Yes = delete, no = hide. If you cancel without answering, it will use the hide option. Then, the script will ask you to select the workbook containing the headings you want to keep (your Specification document). Next the script will ask you to select the workbook containing the data (the workbook you receive daily) you want to filter by deleting/hiding columns. Once you've made your selections, the script will work through the two workbooks to create lists of headings, then match the headings, then delete or hide the columns in the target/daily workbook. When it's done, it saves the target/daily workbook and closes it.
As it goes along, the script will print a basic log to the immediate window in case you want to look at that.
Option Explicit
Sub CleanTargetFile()
Dim strFilterWorkbookPath As String
Dim wbFilterWorkbook As Workbook
Dim arrFilterColumns()
Dim strTargetWorkbookPath As String
Dim wbTargetWorkbook As Workbook
Dim arrTargetColumns()
Dim i As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim varFilterColumn As Variant
Dim varTargetColumn As Variant
Dim arrDeleteTheseColumns()
Dim rngColumns As Range
Dim strPrompt As String
Dim lngButtons As Long
Dim strTitle As String
Dim lngPromptResponse As Long
''https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/msgbox-function
strPrompt = ("Do you want to delete the columns?" & vbNewLine & vbNewLine & "Press Yes to delete columns. Press No to merely hide columns")
lngButtons = 4 'vbYesNo
strTitle = "Delete or Hide Columns"
lngPromptResponse = 7 'set it to hide by default
lngPromptResponse = MsgBox(strPrompt, lngButtons, strTitle)
''Open your spreadsheet with the desired column headers
MsgBox ("Please select the spreadsheet containing your required headings.")
strFilterWorkbookPath = FilePicker()
Set wbFilterWorkbook = Workbooks.Open(strFilterWorkbookPath)
''read the column headers into an array
''https://devblogs.microsoft.com/scripting/how-can-i-build-an-array-from-a-column-of-data-in-excel/
i = 1
x = 0
With wbFilterWorkbook.Sheets(1)
Do Until .Cells(1, i).Value = ""
ReDim Preserve arrFilterColumns(x)
arrFilterColumns(x) = wbFilterWorkbook.Sheets(1).Cells(1, i).Value
i = i 1
x = x 1
Loop
End With
''close your spreadsheet with the desired column headers
wbFilterWorkbook.Close
''Open your the spreadsheet you wish to filter
MsgBox ("Now please select the spreadsheet containing the columns you will be deleting or hiding.")
strTargetWorkbookPath = FilePicker()
Set wbTargetWorkbook = Workbooks.Open(strTargetWorkbookPath)
''read the column headers into an array
i = 1
x = 0
With wbTargetWorkbook.Sheets(1)
Do Until .Cells(1, i).Value = ""
ReDim Preserve arrTargetColumns(x)
arrTargetColumns(x) = wbTargetWorkbook.Sheets(1).Cells(1, i).Value
i = i 1
x = x 1
Loop
End With
''Compare headers to create our target list
i = 0
x = 0
z = 0
For i = UBound(arrTargetColumns) To LBound(arrTargetColumns) Step -1
y = 0
Debug.Print vbNewLine
Debug.Print ("Target Column: " & i 1 & Space(1) & arrTargetColumns(i))
For x = LBound(arrFilterColumns) To UBound(arrFilterColumns)
If StrComp(arrTargetColumns(i), arrFilterColumns(x), vbBinaryCompare) = 0 Then
Debug.Print ("Match: Filter column " & x 1 & " (" & arrFilterColumns(x) & ")" & " is = to Target Column " & i 1 & Space(1) & arrTargetColumns(i))
Debug.Print ("We will keep column " & i 1 & Space(1) & arrTargetColumns(i))
y = 1
End If
Next x
If y = 0 Then
Debug.Print ("No match found - will delete Target Column " & i 1 & Space(1) & arrTargetColumns(i))
ReDim Preserve arrDeleteTheseColumns(z)
arrDeleteTheseColumns(z) = i 1
z = z 1
End If
Next i
Debug.Print vbNewLine
''Delete or Hide columns per user selection at prompt
''Using a select in case you decide to add more options in future, e.g., highlight, etc.
Select Case lngPromptResponse
Case 6 'yes
Set rngColumns = wbTargetWorkbook.Application.Columns
For y = LBound(arrDeleteTheseColumns) To UBound(arrDeleteTheseColumns)
Debug.Print ("Delete Column " & arrDeleteTheseColumns(y))
rngColumns(arrDeleteTheseColumns(y)).Delete
Next y
Case Else
Set rngColumns = wbTargetWorkbook.Application.Columns
For y = LBound(arrDeleteTheseColumns) To UBound(arrDeleteTheseColumns)
Debug.Print ("Hide Column " & arrDeleteTheseColumns(y))
rngColumns(arrDeleteTheseColumns(y)).Hidden = True
Next y
End Select
''Save and close the target workbook
wbTargetWorkbook.Save
wbTargetWorkbook.Close
End Sub
Function FilePicker()
''https://learn.microsoft.com/en-us/office/vba/api/excel.application.filedialog
Dim FilePath As String
With Application.FileDialog(msoFileDialogOpen)
.Show
FilePath = .SelectedItems(1)
End With
FilePicker = FilePath
End Function
CodePudding user response：
Expecting your headers of columns (in sheet where all data are) start in cell "A1" (and continue through "B1", "C1", and so on) and your list of headers (in "column_names" sheet) starts in "A1" (and continues through "A2", "A3", and so on), this code should work.
Regarding your statement that you can easily retrieve original data if something goes wrong and the fact that code below doesn't delete data (just hide it) I didn't implement any protections (except minor one - checking if your "column headers" start in A1 cell).
Sub HideColumns()
Dim rngAllData As Range
Dim rngHeadersList As Range
Dim strShowCol As String
' Check if "A1" cell (in sheet where all data are) is empty.
' If it is emtpy then column headers start somewhere else, so
' change the code below accordingly.
If Range("A1").Value = "" Then
Exit Sub
End If
Set rngAllData = Range("A1", Range("A1").End(xlToRight))
Set rngHeadersList = Sheets("column_names").Range("A1", Sheets("column_names").Range("A1").End(xlDown))
For Each cell In rngAllData
strShowCol = "No"
For Each cell2 In rngHeadersList
If cell.Value = cell2.Value Then
strShowCol = "Yes"
End If
Next
If strShowCol = "No" Then
cell.EntireColumn.Hidden = True
End If
Next
End Sub