CC Name in Adaptive Name Email PDF / Excel

Cost Centre1 Lisa PDF

Cost Centre2 Mathew Excel
Cost Centre3 Mark PDF
Cost Centre4 Luke Excel
Cost Centre5 John Excel
Cost Centre6 Mathew PDF
Cost Centre7 Mark PDF
Cost Centre8 Luke PDF
Cost Centre9 John Excel
Cost Centre10 Mathew Excel
'Publicly declared variables

Dim AllMonths As String 'Holds the workbook name of the "All Months" file
Dim LatestMonth As String 'Holds the workbook name of the "Latest Month" file
Dim MyCostCentre As String 'Holds the cost centre name
Dim MySaveFormat As String 'Holds the name of the format we will save the output as
Dim MyEMail As String 'Holds the email address of the reipient
Dim MySheet1 As String 'Holds the name of "All" sheet for saving
Dim MySheet2 As String 'Holds the name of "Latest" sheet for saving
Dim FileSavePathAndName 'Holds the path and name for the save routines
Dim X As Integer 'A simple counter

Sub TheRunningOrder()
'The questions
'I have gotten macros to format and rename tabs but I am struggling with the following aspects:
'(1) giving an option to choose the downloaded workbooks to work on,
'(2) getting excel to export sheets depending on the cost centre owner into one report (I have a table defining cost centre own
'(3) saving this new file automatically in a new months folder but choosing where to save it.
'Am I asking too much???

Question1
Question2
'Question3 (See SavedFileName sub below)

'Close the two workbooks

Workbooks(LatestMonth).Close
Workbooks(AllMonths).Close

End Sub

Private Sub Question1()

'Call the FilePicker so the user can pick the 2 appropriate files
'Notice here that we will loop twice, changing the title of the dialogue box each time.
'We will also capture the names of the workbooks to 2 variables...
'..."AllMonths" & "LatestMonth" so we can refer to them simply elsewhere
FilePickerButchered

End Sub

Private Sub Question2()

'Here, you'll need to import the appropriate sheets from the...

'...2 newly opened workbooks to this workbook, and then run your code on the....
'...to do this, drop a call to your code in the loop. after the 2 sheets are in.

'Now go back to the "Template" workbook...

'...where this code lives
ThisWorkbook.Activate

'Get the name of this workbook

MyMaster = ThisWorkbook.Name

'Activate the correct sheet

ShLookup.Activate

'select yout start of range

Range("A2").Select

'Loop through all the cost centres...

'...(count = none-blank cells in A, minus 1 for the title
For X = 1 To Application.WorksheetFunction.CountA(Range("A:A")) - 1
'Capture the name of the cost centre
MyCostCentre = ActiveCell.Value
'Capture the format we want to save the output file as
MySaveFormat = ActiveCell.Offset(0, 3).Value
'Capture the email address of the recipient (not used here)
'MyEMail = ActiveCell.Offset(0, 2).Value

'Copy the appropriate sheet from "All Months"

Workbooks(AllMonths).Sheets(MyCostCentre).Copy _
After:=Workbooks(MyMaster).Sheets(1)
'Rename the sheet (as they'll both be the same)!
ActiveSheet.Name = ActiveSheet.Name & " All"
'Copy this name to the variable MySheet1 (for saving purposes)
MySheet1 = ActiveSheet.Name

'Copy the appropriate sheet from "Latest Month"

Workbooks(LatestMonth).Sheets(MyCostCentre).Copy _
After:=Workbooks(MyMaster).Sheets(2)
'Rename the sheet
ActiveSheet.Name = ActiveSheet.Name & " Lastest"
'Copy this name to the variable MySheet2 (for saving purposes)
MySheet2 = ActiveSheet.Name

'Call your code here to do whatever formatting needs to be done!

'CallToLisasCode
 'Call to the saved file path and name builder (Question3)
'...so we know where to save it, and what to call it.
SavedFileName

'Turn off the display alert (for when we delete the sheets we're done with
Application.DisplayAlerts = False

'Logical test to see if this should be saved as a PDF or Excel file...

If MySaveFormat = "PDF" Then
'Call SaveAsPDF routine
SaveAsPDF
'Delete the temporary sheets
Sheets(MySheet1).Delete
Sheets(MySheet2).Delete
Else
'Call SaveAsExcel routine
SaveAsExcel
'Delete the temporary sheets
Sheets(MySheet1).Delete
Sheets(MySheet2).Delete
End If

'Turn the display alerts back on

Application.DisplayAlerts = True

'Go back to the lookup sheet

ShLookup.Select

'Move down a cell

ActiveCell.Offset(1, 0).Select

Next X

End Sub

Private Sub FilePickerButchered()

'The "File Picker"

'This sub opens the file selection dialogue box, and allows the user to select...
'...a file they want to do something with. Note, it only lets the user PICK a...
'file, you then have to decide what to do with it!

'The path and file name are written to...

'...two different variables (declared publicly above), depending on whether...
'...they pick the "All Months" file, or the "Latest Month" file.
Dim WhatWasClicked As Integer 'Captures if a file was selected (0), or not (-1)

'Loop for the number of files you need to open

For X = 1 To 2

'The File Picker itself

With Application.FileDialog(msoFileDialogFilePicker)

'Don't allow multiple selections

.AllowMultiSelect = False

'Add a filter to show only Excel files (you can add multiple types one after the other)
.Filters.Clear 'You must clear old filters first
.Filters.Add "Excel Files", "*.xls?"
'.Filters.Add "Word Files ", "*.doc?"

'Customise the button name

.ButtonName = "Got it!"

'Loop to determine what title to display in the dialogue box...

'...If X = 1 (first pass through loop), display "Select ALL MONTHS"
'Add a title "ALL MONTHS"
If X = 1 Then .Title = "Please select the ALL MONTHS file"
'Add a title "LATEST MONTH"
If X = 2 Then .Title = "Please select the LATEST MONTH file"

'If an initial file path is needed (change as needed)

.InitialFileName = "C:\Users\Alan\Desktop\Demo\"

'Actually shows the dialoge box, and captures either 0 (something was selected), or...
'-1 (nothing was selected, or Cancel was hit)
WhatWasClicked = .Show

'What to do if they didn't pick anything (or hit cancel)

If WhatWasClicked <> -1 Then
'No file picked, or "Cancel" hit...
'Display an appropriate message
MsgBox "You didn't pick anything!"
'End the code there
End
Else

'Read the name of the selected file (this includes the path by the way)
 '...temporarily to the variable "FileName"...we will assign it to our declared
'...variable name, once we establish if this was the first, or second file selected (see below)
FileName = .SelectedItems(1)
'Open the selected file...
Workbooks.Open (FileName)

'Now we establish if this was the 1st, or 2nd file opened (using the current value of X)
If X = 1 Then AllMonths = ActiveWorkbook.Name
If X = 2 Then LatestMonth = ActiveWorkbook.Name

End If

End With

Next X

End Sub

Private Sub SavedFileName()

'Question (3) saving this new file automatically in a new months folder but choosing where to save it.

'Used for auto filing saved files into year/monthly folders

'Change root directory as requited

Dim MyRoot As String 'Holds the root directory

Dim MyYearAndMonth As String 'Holds the rest of the path to where the file should be saved

'Root directory (the 1st part)...

MyRoot = "C:\Users\Alan\Desktop\Demo\"

'Folder names for the months (for the rest of the directory path)
If MonthName(Month(Now) - 1) = "January" Then MyYearAndMonth = Year(Now) & "\01 January\"
If MonthName(Month(Now) - 1) = "February" Then MyYearAndMonth = Year(Now) & "\02February\"
If MonthName(Month(Now) - 1) = "March" Then MyYearAndMonth = Year(Now) & "\03 March\"
If MonthName(Month(Now) - 1) = "April" Then MyYearAndMonth = Year(Now) & "\04 April\"
If MonthName(Month(Now) - 1) = "May" Then MyYearAndMonth = Year(Now) & "\05 May\"
If MonthName(Month(Now) - 1) = "June" Then MyYearAndMonth = Year(Now) & "\06 June\"
If MonthName(Month(Now) - 1) = "July" Then MyYearAndMonth = Year(Now) & "\07 July\"
If MonthName(Month(Now) - 1) = "August" Then MyYearAndMonth = Year(Now) & "\08 August\"
If MonthName(Month(Now) - 1) = "September" Then MyYearAndMonth = Year(Now) & "\09 September\"
If MonthName(Month(Now) - 1) = "October" Then MyYearAndMonth = Year(Now) & "\10 October\"
If MonthName(Month(Now) - 1) = "November" Then MyYearAndMonth = Year(Now) & "\11 November\"
If MonthName(Month(Now) - 1) = "December" Then MyYearAndMonth = Year(Now) - 1 & "\12 December\"
 'Logical test to see if last month (the month we're reporting on)...
'...was December
If MonthName(Month(Now) - 1) <> "December" Then
'Save path for months 1-11
FileSavePathAndName = MyRoot & MyYearAndMonth & "Budget vs Actual - " & _
MonthName(Month(Now) - 1) & " " & Year(Now) & " " & MyCostCentre
Else
'Save path for month 12 (adjustment to the year (-1))
FileSavePathAndName = MyRoot & MyYearAndMonth & "Budget vs Actual - " & _
MonthName(Month(Now) - 1) & " " & Year(Now) - 1 & " " & MyCostCentre
End If

End Sub

Private Sub SaveAsPDF()

'...if we're saving the 2 sheets as a PDF
'Adapted from recorded macro version below

Sheets(Array(MySheet1, MySheet2)).Select
'Sheets("Cost Centre1 All").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
FileSavePathAndName & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub

Private Sub SaveAsExcel()

'...if we're saving the sheets as a new workbook (Excel)
'Adapted from recorded macro version below

'Sheets(Array(MySheet1, MySheet2)).Select
Sheets(Array(MySheet1, MySheet2)).Copy
ChDir "C:\Users\Alan\Desktop\Demo\2017\07 July"
ActiveWorkbook.SaveAs FileName:= _
FileSavePathAndName & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub

Private Sub FilePickerMaster()

'The "File Picker" (not used, butchered version above)

'This sub opens the file selection dialogue box, and allows the user to select...
'...a file they want to do something with. Note, ot only lets the user PICK a...
'file, you then have to decide what to do with it!

'The path and file name are written to, a variable...in this case FileName...
'...which we can then choose to open (FileName will have the path AND the file name automatically)

Dim FileName As String 'Holds the name of the selected file (and the path to it)
Dim WhatWasClicked As Integer 'Captures if a file was selected (0), or not (-1)

'The File Picker itself

With Application.FileDialog(msoFileDialogFilePicker)

'Don't allow multiple selections

.AllowMultiSelect = False

'Add a filter to show only Excel files (you can add multiple types one after the other)
'NOTE: The 1st argument is what appears in the box at the bottom left of the dialogue box
'The 2nd argument is the actual filter (* = any characted, ? = any letter)
'You must clear old filters first
.Filters.Clear
.Filters.Add "Excel Files", "*.xls?"
'.Filters.Add "Word Files ", "*.doc?"

'Add a custom title

.Title = "This is my jazzy custom title...please select a file"

'Set the button name

.ButtonName = "Press me when you're done!"

'If an initial file path if needed (change as required)

.InitialFileName = "C:\Users\Alan\Desktop\Demo\"

'Actually shows the dialoge box, and captures either 0 (something was selected), or...
'-1 (nothing was selected, or Cancel was hit)
WhatWasClicked = .Show

'What to do if they didn't pick anything (or hit cancel)

If WhatWasClicked <> -1 Then
'No file picked, or "Cancel" hit...
'Display an appropriate message
MsgBox "You didn't pick anything!"
'End the code there
End
Else
'Read the name of the selected file to the variable "FileName"
 FileName = .SelectedItems(1)
'Open the selected file...
Workbooks.Open (FileName)
End If

End With

End Sub

Private Sub SaveAsPDFRecordedMacro()

'For reference only...
'Compare this to the amended version used in the finished code...

'...The references to "Cost Centre1 Lastest", "Cost Centre1 All", were changed
'to the names we assigned to the two sheets, as was the path and file name

Sheets(Array("Cost Centre1 Lastest", "Cost Centre1 All")).Select

Sheets("Cost Centre1 All").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\Alan\Desktop\Demo\test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub

Private Sub SaveAsExcelRecordedMacro()

'For reference only...
'Compare this to the amended version used in the finished code...

'...The references to "Cost Centre1 Lastest", "Cost Centre1 All", were changed
'to the names we assigned to the two sheets, as was the path and file name

Sheets(Array("Cost Centre2 All", "Lookup")).Select

Sheets("Lookup").Activate
Sheets(Array("Cost Centre2 All", "Lookup")).Copy
ChDir "C:\Users\Alan\Desktop\Demo\2017\07 July"
ActiveWorkbook.SaveAs FileName:= _
"C:\Users\Alan\Desktop\Demo\2017\07 July\MyFile.xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
End Sub
table defining cost centre owner to cost centre names)
September\"

November\"
2 December\"