Copy Columns based on Header > Paste to a new Excel File

[stseia]

Hello Guys, pretty new here and definitely new to Macros. I am hoping to ask for your help on a possible code that I could use that would hopefully make my work so much easier. Apologies if my details are vague or quite complicated, but here goes, allow me to share the steps that I do manually:

1. First I open up a source file where all data are provided containing but not limited to: Employee's Unique Number, Employee's Full Name, Position and many many more.
2. I determine the report needed from me:

Every Report requires different data from the source file, for example:​

Report 1 would need only: Employee's Unique Number and Name​

Report 2 would need Employee's Unique Number, Employee's Full Name, Position and so on.​

Basically every report would require different data from the source file, hence different columns would need to be copied per report.​

3. I will search for the needed columns for the specific reports and paste them one by one to a new Excel File.
4. Save file.

Features that I think would be helpful:
1. Needed columns will be automatically determined from a dropdown (Based on the Name of the Report)
2. Every report would have different column headers assigned to them (hopefully in a list or table that can be easily edited and be expanded for future purposes in case more reports are needed from me or more columns are added to the source file).
3. Based on the Selected Report from Dropdown, needed headers to be copied are automatically identified and pasted into a new excel file.

In case some things are unclear, or things that I need to know to make these things possible please feel free to let me know.
Thank you for sharing your valuable time with me, cheers!

 

[kevin9999]

Welcome to the forum!
This might take a couple of goes to get right, but here’s a start for you. The code is relatively straightforward, the set-up of the sheets is what will take the effort. I’m assuming you will locate the code in the Source file. It always helps if you provide a sample of your data using the XL2BB add in – you can easily disguise any personal data.
With (at least) 2 sheets in your Source file, and the first sheet looking something like this:

reports.xlsm
	A	B	C	D	E	F	G
1	Employee number	Full name	position	header4	header5	header6	header7
2	123	John Silver	CFO	data	data	data	data
3	321	Paula Brown	Shift Supervisor	data	data	data	data
4	456	Jackie White	Receptionist	data	data	data	data
5	654	Steve Black	Cleaner	data	data	data	data
6	789	Jenny Gold	Consultant	data	data	data	data
7	978	Barry Grey	CEO	data	data	data	data
Sheet1

You could create something like the following in your second sheet. Using a table for your complete list of reports – and associated columns – you can easily add to, change etc. The formulas take care of the rest.

reports.xlsm
	A	B	C	D	E	F	G
1	Select:	Report 3		Report 1		Report Name	Column
2		Employee number		Report 2		Report 1	Employee number
3		header6		Report 3		Report 1	Full name
4		header7				Report 1	position
5						Report 2	Full name
6						Report 2	position
7						Report 2	header4
8						Report 2	header5
9						Report 2	header6
10						Report 3	Employee number
11						Report 3	header6
12						Report 3	header7
13
Sheet2

Cell Formulas
Range	Formula
D1:D3	D1	=SORT(UNIQUE(Table1[Report Name]))
B2:B4	B2	=FILTER(Table1[Column],Table1[Report Name]=B1,"")
Dynamic array formulas.

Cells with Data Validation
Cell	Allow	Criteria
B1	List	=$D$1#
G2	List	=Sheet1!$1:$1
G3:G12	List	=Sheet1!$A$1:$G$1
G13	List	=Sheet1!$1:$1

In brief, once you’ve selected which report you want from the dropdown in cell B1 of sheet2, the code copies the first sheet to a new workbook, then deletes all columns that are not on the formula-created list starting in cell B2, before asking you for a file name/location to save the new file. Put this code in a standard module (and change sheet names etc. to suit).

Option Explicit
Sub Reports()
    Application.ScreenUpdating = False
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Sheet1")
    Set Ws2 = Worksheets("Sheet2")
    
    Dim LRow As Long, Rng1 As Range
    LRow = Ws2.Cells(Rows.Count, 2).End(3).Row
    Set Rng1 = Ws2.Range("B2:B" & LRow)
    
    Dim Wb As Workbook, Ws3 As Worksheet
    Ws1.Copy
    Set Wb = ActiveWorkbook
    Set Ws3 = Wb.Worksheets("Sheet1")
    
    Dim LCol As Long
    LCol = Ws3.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim i As Long
    For i = LCol To 1 Step -1
        If WorksheetFunction.CountIf(Rng1, Ws3.Cells(1, i)) = 0 Then Ws3.Cells(1, i).EntireColumn.Delete
    Next i
    Application.ScreenUpdating = True
    Application.GetSaveAsFilename
End Sub

Let me know how you go with it and feel free to ask any questions for clarification.

 

[stseia]

@kevin9999 Wow, wow and Wow! Everything suits what I have requested, it's amazing how people can make such automation so quick! Instructions are well laid out too, it was easy for me to recreate what you have developed. Can't thank you enough for this.

If you have some extra time, here are some of my inquiries, everything works, just want to ensure if I have done it right:
1. Basically the list for the Entire Column G, are just all the header from Sheet1 correct? Was just a bit confused why the criteria listed on G2 and G13 is different from G3:G12.
2. Was the "#" criteria for B1 a typo? Not sure if it is needed, but it is not working so I just tried "=$D$1" and it works as needed.
3. The save feature doesn't seem to work, I tried inputting file name, however it does not save. Is it possible to autofill in the FileName to have the Report Name on it and perhaps XLSX format? But no need to auto save though, having it filled in automatically in the save prompt will do, just in case I need to change the filename on the go.

Again thank you so much for this, would love as well if you could share a thing or two on a good way to learn Macros. I'm definitely amazed!

 

[kevin9999]

In answer to each of your questions:

• You’re correct, the data validation for when you enter new values in column G comes from row 1 on Sheet1. It was an error on my part – all cells should have the same validation set (all of row 1) and I’ve changed that in the amended sheet below. Because columns F & G are set out as a table, when you add a new report name to the bottom of the list in column F, the cell next to it in column G will automatically get the data validation from the cell above it.
• The hash (#) in the data validation rule for cell B1 is not a typo. It means that the list is a ‘spill’ range from cell D1 down. It’s set up that way because you don’t want to have to edit the validation rule whenever you add a new report name to the bottom of column F. I’m surprised it worked when you removed the hash – when you did that it should have only given you the option of the value in cell D1 and not the cells below it.
• Sorry, I was in a hurry & didn’t test the code fully before I posted it. Please try the amended code below to check the save function. You’ll see the point in execution where you change the file name to suit what you want.

reports.xlsm
	A	B	C	D	E	F	G
1	Select:	Report 1		Report 1		Report Name	Column
2		Employee number		Report 2		Report 1	Employee number
3		Full name		Report 3		Report 1	Full name
4		position				Report 1	position
5						Report 2	Full name
6						Report 2	position
7						Report 2	header4
8						Report 2	header5
9						Report 2	header6
10						Report 3	Employee number
11						Report 3	header6
12						Report 3	header7
13
Sheet2

Cell Formulas
Range	Formula
D1:D3	D1	=SORT(UNIQUE(Table1[Report Name]))
B2:B4	B2	=FILTER(Table1[Column],Table1[Report Name]=B1,"")
Dynamic array formulas.

Cells with Data Validation
Cell	Allow	Criteria
B1	List	=$D$1#
G2:G13	List	=Sheet1!$1:$1

Option Explicit
Sub Reports_V2()
    Application.ScreenUpdating = False
    Dim Ws1 As Worksheet, Ws2 As Worksheet
    Set Ws1 = Worksheets("Sheet1")
    Set Ws2 = Worksheets("Sheet2")
    
    Dim LRow As Long, Rng1 As Range
    LRow = Ws2.Cells(Rows.Count, 2).End(3).Row
    Set Rng1 = Ws2.Range("B2:B" & LRow)
    
    Dim Wb As Workbook, Ws3 As Worksheet
    Ws1.Copy
    Set Wb = ActiveWorkbook
    Set Ws3 = Wb.Worksheets("Sheet1")
    
    Dim LCol As Long
    LCol = Ws3.Cells(1, Columns.Count).End(xlToLeft).Column
    
    Dim i As Long
    For i = LCol To 1 Step -1
        If WorksheetFunction.CountIf(Rng1, Ws3.Cells(1, i)) = 0 Then Ws3.Cells(1, i).EntireColumn.Delete
    Next i
    Application.ScreenUpdating = True
    
    Dim NewName As String, FileSaveName As String, FName
    NewName = "New Report - change to suit"
    FName = Application.GetSaveAsFilename(InitialFileName:=NewName, _
    FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Save As")
    If FName = False Then Exit Sub
    Wb.SaveAs Filename:=FName, FileFormat:=51
    
End Sub

As always, ask as many questions as you like to make sure everything is clear from your side
Cheers
Kev

 

[stseia]

That was a quick reply!
Was able to try it on time personally at work and here are some constraints that I have experienced, please see below if you have more time:

1. Is it possible that the final file will follow the sequence how I have set the headers in Sheet2?
2. Also, in my source file, there are some columns with similar header (messy source file I know, haha), hence the tool copies the same column twice on the final sheet, is it possible to ignore other occurrence of duplicate header and just paste it once?

I think this is all for me for now, again million thanks!

 

[stseia]

That was a quick reply!
Was able to try it on time personally at work and here are some constraints that I have experienced, please see below if you have more time:

1. Is it possible that the final file will follow the sequence how I have set the headers in Sheet2?
2. Also, in my source file, there are some columns with similar header (messy source file I know, haha), hence the tool copies the same column twice on the final sheet, is it possible to ignore other occurrence of duplicate header and just paste it once?

I think this is all for me for now, again million thanks!

@kevin9999 apologies for the second post, I don't know how to delete or edit my previous post, but I forgot to mention you, I am not sure if posting in a thread notifies you, but here goes.

 

[kevin9999]

If anyone adds something to your thread, they're automatically notified whenever there's an addition to it.

Point 1: are you asking for the code to rearrange the selected columns to a new order that you specify in sheet2?
Point 2: The code doesn't actually copy specific columns - it copies sheet1 in its entirety, then it deletes any columns you haven't listed on sheet2 in your report list for that particular report. I'm not sure why you'd have 2 columns with the same header on sheet1 (is there a need for that?) but I would look to change - even slightly - one of those similar headers.

 

[stseia]

@kevin9999 Hello!
Point 1: It will follow the order listed in Column B from Top to Bottom, Say for example B2: Employee Number B3: Full Name B4: Position, in the Sheet 2, Employee number will end up in A1, Full Name in A2, Position in A3 and so on, hope that does not make things even more confusing.
Point 2: For some reason it is the way it is created (I am not the one who created the source file), I guess I can work with renaming duplicate headers manually before running the macro.

 

[kevin9999]

@kevin9999 Hello!
Point 1: It will follow the order listed in Column B from Top to Bottom, Say for example B2: Employee Number B3: Full Name B4: Position, in the Sheet 2, Employee number will end up in A1, Full Name in A2, Position in A3 and so on, hope that does not make things even more confusing.
Point 2: For some reason it is the way it is created (I am not the one who created the source file), I guess I can work with renaming duplicate headers manually before running the macro.

Thank you for the clarifications. Could you provide a sample of sheet1 (you can hide personal info) using the XL2BB add in (like I did in posts #2 & #4). It will make my job much easier

 

[stseia]

@kevin9999 apologies for making things difficult, unfortunately there is no way for me to copy all the headers as it is too many, and sadly I cannot get a local copy of my own of the file on the Office Device due to some flash drive restrictions and data privacy concerns. Is there any other way I can help you with to make this possible?