3
\$\begingroup\$

Work flow is:

  • Copy Previous Year Reports Folder
  • Update Following Templates
  • Save
  • Close

There are 19 workbooks in the Source Folder and in the NewYear Folder. Each Workbook has to save the final data from the end of the year (the "YTD ACTUAL" pages) along with resetting and prepping the month sheets for the new year.

Don't be afraid to trash me or offend me. I obviously am new to this, and there has to be a better way to do it.

Private Sub Workbook_Open()

Dim CYR As Variant, PYR As Integer, InputError As Integer, SourceFolder As String, NewYearFolder As String, NewYearFiles As String, oFSO As Object, oNewYearFolder As Object, oNewYearFiles As Object, filename As Variant

CYR = InputBox("Input New Year in 4 Digit Format. XXXX")
    On Error GoTo ErrorCheck

PYR = CYR - 1
SourceFolder = "C:\Users\nick.hasler\Desktop\Daily Service Reporting\" & PYR & " Service Report - Daily"
NewYearFolder = "C:\Users\nick.hasler\Desktop\Daily Service Reporting\" & CYR & " Service Report - Daily"
NewYearFiles = Dir(NewYearFolder & "\" & "*.xl??")

Application.ScreenUpdating = False
Application.EnableEvents = False

If Dir(NewYearFolder, vbDirectory) = "" Then

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    oFSO.copyFolder SourceFolder, NewYearFolder

    MsgBox "New Year Folder Created"

    Set oNewYearFolder = oFSO.GetFolder(NewYearFolder)
    Set oNewYearFiles = oNewYearFolder.Files

    For Each filename In oNewYearFiles
        If filename Like "*" & PYR & "*" Then
          NewFileName = Replace(filename, PYR, CYR)

          Name filename As NewFileName
        End If
    Next filename

    MsgBox "New Year Files Renamed"
    MsgBox "The Next Step Will Take a Few Moments"

    NewYearFiles = Dir(NewYearFolder & "\" & "*.xl??")

    Do While NewYearFiles <> ""
        Workbooks.Open (NewYearFolder & "\" & NewYearFiles)

        Workbooks(NewYearFiles).Sheets(PYR & " YTD").Select
        Workbooks(NewYearFiles).Sheets(PYR & " YTD").Name = CYR & " YTD"
        Workbooks(NewYearFiles).Worksheets("2019 Actual").Select
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Copy Before:=Workbooks(NewYearFiles).Worksheets(CYR & " YTD")
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual (2)").Select
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual (2)").Name = CYR & " Actual"
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Select
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Cells.Select
        Selection.Copy
        Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Range("A1").Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False

        'Monthly Reporting
        Workbooks("Create New Year").Worksheets("Monthly Reporting").Range("A5:AH16").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("Monthly Reporting").Range("A5:AH16")

        Workbooks("Create New Year").Worksheets("Monthly Reporting").Range("H76:AH88").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("Monthly Reporting").Range("H76:AH88")

            Workbooks(NewYearFiles).Worksheets("Monthly Reporting").Range("A1:AH90").Replace What:="qqq", Replacement:="="

            Workbooks(NewYearFiles).Worksheets("Monthly Reporting").Range("A1:J4").Replace What:=PYR, Replacement:=CYR

        'Daily Reporting
        Workbooks("Create New Year").Worksheets("Daily Reporting").Range("A2:AG18").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("Daily Reporting").Range("A2:AG18")

            Workbooks(NewYearFiles).Worksheets("Daily Reporting").Range("A1:AG18").Replace What:="qqq", Replacement:="="

            Workbooks(NewYearFiles).Worksheets("Daily Reporting").Range("A3:AG3").Replace What:="Year", Replacement:=CYR

        'January
        Workbooks("Create New Year").Worksheets("January").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("January").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("January").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("January").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("January").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'February
        Workbooks("Create New Year").Worksheets("February").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("February").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("February").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("February").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("February").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'March
        Workbooks("Create New Year").Worksheets("March").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("March").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("March").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("March").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("March").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'April
        Workbooks("Create New Year").Worksheets("April").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("April").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("April").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("April").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("April").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'May
        Workbooks("Create New Year").Worksheets("May").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("May").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("May").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("May").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("May").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'June
        Workbooks("Create New Year").Worksheets("June").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("June").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("June").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("June").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("June").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'July
        Workbooks("Create New Year").Worksheets("July").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("July").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("July").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("July").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("July").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'August
        Workbooks("Create New Year").Worksheets("August").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("August").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("August").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("August").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("August").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'September
        Workbooks("Create New Year").Worksheets("September").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("September").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("September").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("September").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("September").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'October
        Workbooks("Create New Year").Worksheets("October").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("October").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("October").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("October").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("October").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'November
        Workbooks("Create New Year").Worksheets("November").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("November").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("November").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("November").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("November").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        'December
        Workbooks("Create New Year").Worksheets("December").Range("A7:AFH46").Copy _
            Destination:=Workbooks(NewYearFiles).Worksheets("December").Range("A7:AFH46")

            Workbooks(NewYearFiles).Worksheets("December").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR

            Workbooks(NewYearFiles).Worksheets("December").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR

            Workbooks(NewYearFiles).Worksheets("December").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

        Application.CutCopyMode = False

        Workbooks(NewYearFiles).Save
        Workbooks(NewYearFiles).Close
        NewYearFiles = Dir()
    Loop

    MsgBox "New Year Files Reset"

Else
    InputError = 1
End If


ErrorCheck:
If CYR = "" Then
    MsgBox "You did not input a valid year"
End If

If InputError = 1 Then
    MsgBox "That Year Already Exist. Delete the folder if you wish to replace it."
End If

Application.ScreenUpdating = True
Application.EnableEvents = True

'Workbooks("Create New Year").Save
'Workbooks("Create New Year").Close

End Sub
\$\endgroup\$
  • 2
    \$\begingroup\$ Welcome to Code Review. Consider tagging your question beginner. \$\endgroup\$ – greybeard Jul 24 at 2:53
  • \$\begingroup\$ @greybeard Done. Any ideas on how to optimize my mess? \$\endgroup\$ – Nick Hasler Jul 24 at 14:51
  • 1
    \$\begingroup\$ @NickHasler patience young grasshopper... :) Doing a good code review takes quite a bit of time. I'd expect you'll get at least one good review, but you should expect that it may take 24 or more hours before it's posted. Some folks will take more than an hour of their time to review your code, then another hour or more to write it up. \$\endgroup\$ – FreeMan Jul 24 at 15:11
  • \$\begingroup\$ In the meantime, take the tour and read through the help center. It will pass some of the time and give you an idea of what to expect 'round here. \$\endgroup\$ – FreeMan Jul 24 at 15:12
  • \$\begingroup\$ @FreeMan I skimmed both of them before posting. That's where the "don't be afraid to offend me" came from. I will wait patiently. Just wanted to know if he had any broad tips \$\endgroup\$ – Nick Hasler Jul 24 at 15:47
4
\$\begingroup\$

Don't be afraid to trash me or offend me.

Ok, I'll bite ;-)

But this isn't about you, it's all about the code. It's always about the code. Reviewers are not here to judge, they're here to help you grow, and improve your programming!

I obviously am new to this, and there has to be a better way to do it

Oh, yes, absolutely. But first, I need to know what it does. So I glance at the code, and see a Workbook.Open handler - the macro runs every time ThisWorkbook (i.e. the host Excel document) is opened, which - in my opinion - isn't a terrific user experience. I personally prefer opening the workbook on an empty sheet that hides gridlines, row/column headings, and the formula bar; on it you'd find a number of formatted shapes/buttons, each assigned to a Public Sub procedure that lives in a standard module. That way the macro runs as a result of a user action beyond just opening the workbook.

But let's just go with "well it runs on open, they wanted it that way".

So the first thing we see is a string of chained declarations:

Dim CYR As Variant, PYR As Integer, InputError As Integer, SourceFolder As String, NewYearFolder As String, NewYearFiles As String, oFSO As Object, oNewYearFolder As Object, oNewYearFiles As Object, filename As Variant

That's great, variables are being declared! Only problem is, Option Explicit is obviously missing at the top of the module, because it wouldn't compile otherwise: NewFileName isn't declared.

One problem with declaring a bunch of variables at the top of a procedure scope like this (ignoring the outrageous horizontal scrolling), is that it makes them look like checking a box off some list of things that need to be done ("declare variables: check!") - and the string of variables becomes essentially noise; code that needs to be there, but code that is systematically ignored/skipped, because what do we care about a variable that's used 200 lines below, when we're reading around the top of the procedure?

Compare to declaring variables as close as possible to their first use:

Dim CYR As Variant
CYR = InputBox("Input New Year in 4 Digit Format. XXXX")
On Error GoTo ErrorCheck

Dim PYR As Integer
PYR = CYR - 1

Now the wall/string/chain of declarations is gone, and we see variables' declarations exactly where they are relevant.

But we need to stop right here and talk about separation of concerns. Procedures should be simple. Like, stupid simple. This Workbook.Open handler has a cyclomatic complexity of 6, which is a little high. What's that? It's an objective metric that can be used to identify potentially problematic areas in source code. Essentially, how many possible execution paths are there? And the answer here is "too many!". In a dream world, an event handler should look like this:

Private Sub SomeObject_SomeEvent()
    DoSomething
End Sub

That's right - a high abstraction one-liner! What happens when SomeEvent is fired? We DoSomething! In this case, we might be abstracting the logic behind a procedure named CreateMonthlyReportingBook, and so we would be looking at Workbook_Open and when asked "what happens when the workbook opens?" we could say "we create a monthly reporting book", and that would be enough information for anyone that doesn't need every little bit of detail of how that's done.

So what would CreateMonthlyReportingBook do? Two or three closely related things:

Private Sub CreateMonthlyReportingBook()
    Dim yearToProcess As Long
    If Not PromptForYearToProcess(yearToProcess) Then Exit Sub
    If Not CreateYearFolder(yearToProcess) Then Exit Sub
    ProcessYearFiles yearToProcess
End Sub

Note how pulling the InputBox and input validation into its own function, we instantly get the desired functionality (bail out on invalid input) without needing to track some "input error" variable that's actually used... pretty much 200 lines below where it's relevant.

Here PromptForYearToProcess would take the yearToProcess value as a ByRef argument - the function might look like this:

Private Function PromptForYearToProcess(ByRef outYear As Long) As Boolean
    'prompt for what year to process...
    'validate user input...
    'assign outYear parameter with the validated user input...
    'return true if everything went well and outYear is valid.
End Function

The job of CreateYearFolder is to create the folder for the new year and prepare it for processing. If it can't do that (e.g. year folder already exists, or some I/O error is otherwise preventing successful completion), the rest of the procedure bails out.

ProcessYearFiles would be where we iterate the folder for the specified year, and start iterating the workbooks to work with - but the "real work" would be in another procedure, one that takes a Workbook parameter; perhaps something like ConfigureYearBook - a procedure that's given a workbook and proceeds to do what needs to be done with it: it knows nothing of the bigger picture, all it cares about is that there's a workbook that needs processing, and it knows what that processing needs to be.

And inside this ConfigureYearBook procedure, there would be a call to another procedure - ConfigureMonthSheet, which would be given a Worksheet (and the PYR value), and be responsible for setting up the worksheet for that particular month.

So this copy-pasta repeated chunk...

Workbooks("Create New Year").Worksheets("January").Range("A7:AFH46").Copy _
    Destination:=Workbooks(NewYearFiles).Worksheets("January").Range("A7:AFH46")

Workbooks(NewYearFiles).Worksheets("January").Range("A1:AFH7").Replace What:=PYR, Replacement:=CYR
Workbooks(NewYearFiles).Worksheets("January").Range("ADZ7:AFH7").Replace What:="PYear", Replacement:=PYR
Workbooks(NewYearFiles).Worksheets("January").Range("A2:AFH46").Replace What:="qqq", Replacement:="="

...could actually look like this:

Private Sub ConfigureMonthSheet(ByVal sheet As Worksheet, ByVal previousYear As Long)
    ThisWorkbook.Worksheets(sheet.Name).Range("A7:AFH46").Copy _
        Destination:=sheet.Range("A7:AFH46")
    sheet.Range("ADZ7:AFH7").Replace "PYear", prevousYear
    sheet.Range("A2:AFH46").Replace "qqq", "="
End Sub

So ConfigureYearBook would be iterating an array of month/sheet names, and invoking ConfigureMonthSheet for each destination sheet.

A note about this:

Workbooks.Open (NewYearFolder & "\" & NewYearFiles)

You're discarding the Workbook reference returned by the Workbooks.Open function. Declare a variable...

Dim targetBook As Workbook
Set targetBook = Workbooks.Open(NewYearFolder & "\" & NewYearFiles)

And now you can use that object reference instead of repeatedly dereferencing it from the Workbooks collection every time you need it:

    Workbooks(NewYearFiles).Sheets(PYR & " YTD").Select
    Workbooks(NewYearFiles).Sheets(PYR & " YTD").Name = CYR & " YTD"
    Workbooks(NewYearFiles).Worksheets("2019 Actual").Select
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Copy Before:=Workbooks(NewYearFiles).Worksheets(CYR & " YTD")
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual (2)").Select
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual (2)").Name = CYR & " Actual"
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Select
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Cells.Select
    Selection.Copy
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Line continuations are useful, but please avoid using them in weird places (the macro recorder likes putting them in stupid arbitrary locations), like between a named argument's name and that named argument's value:

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

SkipBlanks is the named argument, := is the operator that makes VBA understand it as such, and False is the argument's value; try to keep named arguments together with their values, seeing the := operator at the beginning of a line of code means the reader's eyes need to drift upwards and right to find what argument that value is for, and that's ojectively bad.

    Workbooks(NewYearFiles).Worksheets(PYR & " Actual").Copy Before:=Workbooks(NewYearFiles).Worksheets(CYR & " YTD")
    Workbooks(NewYearFiles).Worksheets(PYR & " Actual (2)").Select

The Copy should be automatically activating the new sheet, so that .Select is entirely redundant; " Actual (2)" is already the ActiveSheet at that point, so the subsequent lines should do something along the lines of...

targetBook.Worksheets(PYR & " Actual").Copy _
    Before:=targetBook.Worksheets(CYR & " YTD")

Dim sheet As Worksheet
Set sheet = ActiveSheet

sheet.Name = CYR & " Actual"
sheet.Cells.Copy
sheet.Range("A1").PasteSpecial _
    Paste:=xlPasteValues, _
    Operation:=xlNone, _
    SkipBlanks:=False, _
    Transpose:=False

But, there's no need to involve the clipboard here:

'overwrite formulas with their values:
sheet.UsedRange.Value = sheet.UsedRange.Value

Note that doing this with sheet.Cells instead of sheet.UsedRange would very likely result in an "out of memory" error - sending every single cell in the worksheet into the clipboard is MASSIVELY inefficient: we're talking 16K columns times over a million rows, i.e. well over a billion cells - most of which empty.


There's a lot to say about this code, and many ways it can be improved. Performance-wise, there is quite a bit of I/O work involved (opening files, saving them, closing them) that has very little room for any performance gains. However removing the Select/Activate stuff, minimizing clipboard use, reducing redundant object dereferencing, will all contribute to improve the overall performance.

But before tweaking for performance, my advice would be to tweak for readability and maintainability first. Increase the level of abstraction by extracting "this chunk of code does XYZ" instructions into their own procedure scopes, then split these further into smaller, more specialized procedures that do what they need to do and nothing else; use meaningful, fully spelled-out identifier names; if CYR stands for currentYear, then name it that; if PYR stands for previousYear, then name it that; name procedures with a verb, keep nouns for variables.

What you absolutely want to avoid, is looking at a single "god procedure" that does everything, knows everything, controls everything. Split. Things. Up. A procedure that's 5-10 lines long can only go wrong in a limited number of ways. A 200-liner procedure has many, many more reasons to fail, and that makes it much more complicated.

A User Experience (UX) note about this:

MsgBox "New Year Files Renamed"
MsgBox "The Next Step Will Take a Few Moments"

Avoid obnoxious user prompts like that. One MsgBox is annoying, two back-to-back is irritating (arguably the two messages could be merged into one). Since this is obviously a long-running process that needs to go through a number of files, consider using a Progress Indicator to let the user know what's going on, instead of message boxes.

\$\endgroup\$
  • \$\begingroup\$ Can you further explain the CreateMonthlyReportingBook Sub you have typed up. I don't understand the yeartoprocess variable's purpose and I get a compile error(wrong number of arguments or invalid property assignment) which I can't fix because I don't understand why we're passing a value to the other subs in the first place. If I remove the variable I get a different compile error(expected function or variable). If I completely remove the variable and the if not statements then I can get it to compile and run fine, but im missing the error checking \$\endgroup\$ – Nick Hasler Jul 24 at 21:11
  • 1
    \$\begingroup\$ @NickHasler edited to clarify - yearToProcess is a ByRef output parameter; if the function returns True then it's valid and usable. CreateYearFolder would also be a Function, that returns True when everything is in place and good to go, False otherwise (whatever the reason is). Parameters should be ByVal everywhere, except in PromptForYearToProcess where it's passed ByRef. \$\endgroup\$ – Mathieu Guindon Jul 24 at 21:29
  • \$\begingroup\$ Thank you again for your help \$\endgroup\$ – Nick Hasler Jul 24 at 22:30

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.