Making a report from payroll details

Question

*** PS_HOURS.3_1
    July      |1    |2    |3    |4    |5    |6    |7
    Name        |Total|Total|Total|Total|Total|Total|Total
    Abram, John   |1.00 |     |     |     |3.00 |3.00 |3.00
    Agara, Hara   |2.00 |     |     |     |2.00 |2.00 |3.00
    Alsi, Idria   |2.00 |     |     |     |2.00 |2.00 |2.00
    Amon, Char    |2.00 |     |     |     |3.00 |3.00 |2.00
    Base, Adron   |3.00 |     |     |     |3.00 |2.00 |3.00

Screenshot:

Data is entered into this spreadsheet manually:

1. Job coaches write down a clients start time/stop time on a piece of paper
2. This paper is then brought to the person who works in our central office, and she takes all the pieces of paper (probably about 8-9 pieces of paper for a week and makes a hand written master sheet which looks like above (minus the quarter hours), but is 55 rows deep and 31 columns wide. If for instance Hara Agara works on July 13th then that box is filled in with the amount of hours he worked for that day.
3. I input her master sheet into this spreadsheet. I could easily have her do it, but at least the theory now is that the agency still needs to maintain paper copies.

I have the following functional macro based on the above. There's a list of 55 names, and a record of the hours they've worked for every day of the month (31 total columns) starting from cell C going to cell BK (skipping by 2's); cell D going to cell BJ (also skipping by 2's) is a record of the total amount of hours they've worked translated into quarter hour units (i.e. 2 hours worked = 8 hour quarter units). I use this for reporting purposes.

At the far right the total amount of hours a person worked is summed up, and is then reported on a summary page. Each month is given it's own worksheet - IE there's a record for June, July, August, with the name of the worksheet being its NameOfMonth.year.

This data is used to generate the following report:

Report for John Abram

     a     b      c      d      e     f    g      h     i   j  k  l  m  n  o->AF
6 |Date |Staff|Present|ratio|start|stop |total|minwag|hab#|s1|s2|s3|s4|s5|...
7 |07/01| BP  | Yes   | 1:1 | 8:00| 9:00|1    | yes  |2   |x |  |x |  |  | xx
8 |07/02| BP  | Yes   | 1:1 |     |     |0    |      |    |  |  |  |  |  | 
9 |07/03| BP  | Yes   | 1:1 |     |     |0    |      |    |  |  |  |  |  | 
10|07/04| BP  | Yes   | 1:1 |     |     |0    |      |    |  |  |  |  |  | 
11|07/05| BP  | Yes   | 1:1 | 8:00|11:00|3    | yes  |2   |x |  |x |  |  | xx 
12|07/06| BP  | Yes   | 1:1 | 8:00|11:00|3    | yes  |2   |  | x|x |  |  | xx         
13|07/07| BP  | Yes   | 1:1 | 8:00|11:00|3    | yes  |2   |x |  |x |  |  | xx

looks like this:

Here's what happens:

• In column g there is an index/match function that is keyed to find the data from the corresponding worksheet in PS_Hours.3_1. More on how the spreadsheet knows which worksheet later
• Column E is set to 8:00 AM, and then column F adds the total amount of time (column g) to column f to get a finish time. In the case of John Abram for 07/01, it's 1 hour of work; so start time and end time are 1 hour a part
• Each worksheet contains 7 days of information, in this case from 07/01-07/07. Some of the information is static (columns b,c,d, and what is in columns 0 through AF), but only gets entered if the value in column g of that row is greater than 0
• Column i of each row is a random number between 1 and 3 only if column g of that row is greater than 0.
• Cell j/k/l are randomly filled based on column i of each row.

Now on to the macro portion:

This needs to be done for each person (55 total) so I had to automate the copy/pasting of it:

Sub copy()
'
' copy Macro
'
' Keyboard Shortcut: Ctrl+d
'

Dim dValue, mIndex, mName As Integer

'copy the worksheet to a new worksheet and format it
Range("A1:AF19").Select
Range("AA19").Activate
Selection.copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 8
Columns("C:C").ColumnWidth = 10
Columns("D:D").ColumnWidth = 10
Columns("E:E").ColumnWidth = 8
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 6
Columns("H:H").ColumnWidth = 6
Columns("I:I").ColumnWidth = 6
Columns("J:J").ColumnWidth = 10
Columns("K:K").ColumnWidth = 10
Columns("L:L").ColumnWidth = 10
Columns("M:M").ColumnWidth = 1
Columns("N:N").ColumnWidth = 1
Columns("O:O").ColumnWidth = 5
Columns("P:P").ColumnWidth = 5
Columns("Q:Q").ColumnWidth = 5
Columns("R:R").ColumnWidth = 5
Columns("S:S").ColumnWidth = 5
Columns("S:S").ColumnWidth = 5
Columns("T:T").ColumnWidth = 5
Columns("U:U").ColumnWidth = 5
Columns("V:V").ColumnWidth = 5
Columns("W:W").ColumnWidth = 5
Columns("X:X").ColumnWidth = 5
Columns("Y:Y").ColumnWidth = 5
Columns("Z:Z").ColumnWidth = 5
Columns("AA:AA").ColumnWidth = 5
Columns("AB:AB").ColumnWidth = 5
Columns("AC:AC").ColumnWidth = 5
Columns("AD:AD").ColumnWidth = 5
Columns("AE:AE").ColumnWidth = 5
Columns("AF:AF").ColumnWidth = 5
Rows("5:5").RowHeight = 55
Rows("7:7").RowHeight = 50
Rows("8:8").RowHeight = 50
Rows("9:9").RowHeight = 50
Rows("10:10").RowHeight = 50
Rows("11:11").RowHeight = 50
Rows("12:12").RowHeight = 50
Rows("13:13").RowHeight = 50
Rows("19:19").RowHeight = 50
Rows("18:18").RowHeight = 50
Rows("17:17").RowHeight = 50
Rows("14:14").RowHeight = 70


Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .PrintTitleRows = ""
    .PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
    .LeftHeader = ""
    .CenterHeader = ""
    .RightHeader = ""
    .LeftFooter = ""
    .CenterFooter = ""
    .RightFooter = ""
    .LeftMargin = Application.InchesToPoints(0.7)
    .RightMargin = Application.InchesToPoints(0.7)
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.3)
    .FooterMargin = Application.InchesToPoints(0.3)
    .PrintHeadings = False
    .PrintGridlines = False
    .PrintComments = xlPrintNoComments
    .PrintQuality = 600
    .CenterHorizontally = False
    .CenterVertically = False
    .Orientation = xlLandscape
    .Draft = False
    .PaperSize = xlPaperLetter
    .FirstPageNumber = xlAutomatic
    .Order = xlDownThenOver
    .BlackAndWhite = False
    .Zoom = 100
    .PrintErrors = xlPrintErrorsDisplayed
    .OddAndEvenPagesHeaderFooter = False
    .DifferentFirstPageHeaderFooter = False
    .ScaleWithDocHeaderFooter = True
    .AlignMarginsHeaderFooter = True
    .EvenPage.LeftHeader.Text = ""
    .EvenPage.CenterHeader.Text = ""
    .EvenPage.RightHeader.Text = ""
    .EvenPage.LeftFooter.Text = ""
    .EvenPage.CenterFooter.Text = ""
    .EvenPage.RightFooter.Text = ""
    .FirstPage.LeftHeader.Text = ""
    .FirstPage.CenterHeader.Text = ""
    .FirstPage.RightHeader.Text = ""
    .FirstPage.LeftFooter.Text = ""
    .FirstPage.CenterFooter.Text = ""
    .FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.Zoom = 85
ActiveWindow.Zoom = 100
ActiveWindow.Zoom = 115
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1

'get the current date value and month value
dValue = Int(Right(Cells(7, 1), 2))
mValue = Int(Left(Cells(7, 1), 2))



If (31 - dValue) > 7 Then
    Call updateDates
Else
    Call newMonth(mValue)
End If
End Sub

This sub takes the current spreadsheet that's active when ctrl-d is pressed, makes a new spreadsheet, formats it. Then it examines the last two digits of the date in cell a7; if 31-that number is greater than 7, the macro knows that it can safely move to the next set of 7 numbers; if it's less than it knows that the new month is coming up.

Sub updateDates()
Dim dValue, n_mValue, yValue As Integer

n_mValue = Int(Left(Cells(2, 26), 2)) + 1
yValue = Int(Right(Cells(2, 26), 4))

'Calculation for the first day of the following month
date_next_month = DateSerial(yValue, n_mValue, 1)

'Date of the last day
last_day_month = date_next_month - 1
'Number for the last day of month (= last day)
nb_days = Day(last_day_month)

'update the day/month values in cells 7,1 through 13,1
For i = 0 To 6
    dValue = Day(Cells(7 + i, 1))
    If dValue + 7 <= nb_days Then
        Cells(7 + i, 1) = format(DateAdd("d", 7, Cells(7 + i, 1)), "mm/dd")
    Else
            For j = 1 To 32
                Cells(7 + i, j) = ""
            Next j
    End If
Next i
Call paperwork
End Sub

This sub is only called when 31 minus the right two digits in cell a7 are greater than 7 (or when it's not the last week in the current month).

It updates dates based on the first day of the next month and previous values, and it also wipes the values in each spreadsheet clean.

Sub newMonth(mValue)
    Dim mName1, mName2, CurYear As String

    For i = 0 To 6
        Cells(7 + i, 1) = format(DateSerial(2016, mValue + 1, i + 1), "mm/dd")
    Next i



    Range("B7:AF7").Select
    Selection.copy
    Range("B8").Select
    ActiveSheet.Paste
    Range("B9").Select
    ActiveSheet.Paste
    Range("B10").Select
    ActiveSheet.Paste
    Range("B11").Select
    ActiveSheet.Paste
    Range("B12").Select
    ActiveSheet.Paste
    Range("B13").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("B7:AF13").Select

    'mValue is current month

    mName1 = Switch(mValue = 1, "January", mValue = 2, "February", mValue = 3, "March", mValue = 4, "April", mValue = 5, "May", mValue = 6, "June", mValue = 7, "July", mValue = 8, "August", mValue = 9, "September", mValue = 10, "October", mValue = 11, "November", mValue = 12, "December")
    mValue = mValue + 1
    mName2 = Switch(mValue = 1, "January", mValue = 2, "February", mValue = 3, "March", mValue = 4, "April", mValue = 5, "May", mValue = 6, "June", mValue = 7, "July", mValue = 8, "August", mValue = 9, "September", mValue = 10, "October", mValue = 11, "November", mValue = 12, "December")
    mName2 = mName2 & "." & Right(Cells(2, 26), 4)

    Selection.Replace What:=mName1, Replacement:=mName2, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False

    Call paperwork

End Sub

---

Basically, what do I do when I get to the end of the month? I have to start a new month (from the 8's).

If called, this macro finds the current month, adds 1, and replaces all occurrences of the previous month with the next month, and updates accordingly. Then calls paperwork sub.

---

Sub paperwork()
'
' paperwork Macro
'
'
    Dim numHabs, rando As Integer

'first have to clear out anything that was previously written in the middle section


        For i = 0 To 7
                If (Cells(7 + i, 7) > 0) Then
                    Cells(7 + i, 9) = Int(3 * Rnd() + 1)
                Else
                    Cells(7 + i, 9) = ""
                End If
            For j = 0 To 22
                Cells(7 + i, 10 + j) = ""
            Next j
        Next i

'put some new stuff in

    For k = 0 To 4
        For i = 0 To 7
                If Cells((7 + 20 * k) + i, 9) > 0 Then
                    numHabs = Cells(7 + i, 9)
                    Cells(7 + i, 20) = "X"
                    Cells(7 + i, 25) = "X"     
                End If
           ' MsgBox ("num habs" = numHabs)
            While numHabs > 0
                rando = Int(3 * Rnd() + 10)
                If Cells((7 + 20 * k) + i, rando).Value = "" Then
                    Cells((7 + 20 * k) + i, rando) = "x"
                    numHabs = numHabs - 1
                End If
            Wend
        Next i     
   Next k
    Call facetoface
End Sub

This sub fills cells j/k/l on the sheet dynamically. Important, because this shows that whoever is responsible for overseeing work that day actually did something that day.

Sub facetoface()
    Dim pctTime, tempTime, tempWrk As Integer
    Dim base, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10 As String
    Dim Services As New Collection
    Dim Name() As String

    base = "Purpose and/or Response to Services Provided: "
    Name = Split(Cells(3, 4), ", ", -1)
    'MsgBox (Name(0))

    Services.Add "% of time spent working with " & Name(1) & " on developing job skills and ability to cope with the demands of the work place; "
    Services.Add "% of time spent working with " & Name(1) & " on developing soft skills and ability to speaking properly with others at the work site; "
    Services.Add "% of time spent working with " & Name(1) & " on developing good time-keeping habits; "
    Services.Add "% of time spent working with " & Name(1) & " on issues that were independently raised to me; "
    Services.Add "% of time spent working with " & Name(1) & " on arriving and leaving work properly; "
    Services.Add "% of time spent working with " & Name(1) & " to help them understand job goals at the work site; "
    Services.Add "% of time spent working with " & Name(1) & " on developing better habits; "
    Services.Add "% of time spent working with " & Name(1) & " on issues that were raised by a Medicaid Service Coordinator; "
    Services.Add "% of time spent working with " & Name(1) & " on finding new work opportunities; "
    Services.Add "% of time spent working with " & Name(1) & " on job training; "

'    MsgBox (Services.Item(2))
    For i = 0 To 2

        If i < 2 Then
            tempTime = Round((Int(40 * Rnd() + 10) / 10), 0) * 10
            pctTime = pctTime + tempTime
        Else
        '    MsgBox ("PctTime" & pctTime & "TempTime" & tempTime)
            tempTime = 100 - pctTime

        End If

        tempWrk = Int(8 * Rnd() + 1)
        base = base & " " & tempTime & Services.Item(tempWrk)
        Services.Remove tempWrk

    Next i  
   ' MsgBox (base)
    If Application.WorksheetFunction.Sum(Cells(7, 7), Cells(8, 7), Cells(9, 7), Cells(10, 7), , Cells(11, 7), Cells(12, 7), Cells(13, 7)) = 0 Then
        base = "Purpose and/or Response to Services Provided: " & Name(1) & " did not work during this period."
    Else
        base = Left(base, Len(base) - 2)
    End If  
    Cells(14, 1) = base  
'find the range of dates for the period
    str1 = Cells(7, 1)
   ' MsgBox (str1)

    For i = 1 To 6
        'MsgBox (Cells(7 + i, 1))

        If Cells(7 + i, 1).Value = "" Then
            str2 = Cells(6 + i, 1)
     '       MsgBox ("i = " & i & " & str2 = " & str2)
            Exit For
        ElseIf i = 6 Then
            str2 = Cells(13, 1)
            Exit For

        End If
    Next i      
    Cells(2, 26) = str1 & "/" & Year(Now()) & " - " & str2 & "/" & Year(Now())
    ActiveSheet.Name = Left(str1, 2) & "." & Right(str1, 2) & "-" & Left(str2, 2) & "." & Right(str2, 2)

End Sub

This sub finds 3 randomly selected strings from 10 pre-generated strings to make an output string, which is then placed on cell a14. A sample output would look like.

Purpose and/or response to services provided: 50% of time spent working with John to help them understand job goals at the work site; 40% of time spent working with John on issues that were independently raised to me; 10% of time spent working with John on developing job skills and ability to cope with the demands of the work place.

I work in the human services field and the paperwork requirement can be overbearing. Case notes needs to be written up regularly which I do not want to do, so I decided to try my hand at using Excel/VBA to write them up. Basically, the way this is written, all I need to do is press ctrlD. As long as sufficient data exists in PS_HOURS.3_1 the macro will generate and format a sufficient case note for that period.

Some issues/hopes for future improvement:

1. Haven't yet had to switch years
2. It might be better to do this with a dynamic way to enter times; so each person doesn't always start at 8:00 AM, but can start whenever depending upon how they are entered into the system.
3. It might be better to do this with a database; I don't know the maximum amount of worksheets that excel can have (probably easy to look it up), but at the very least a year of case notes will have 52 work sheets, so it might run into a limit.
4. Overall it seems very clunky and trying to generate an output string based on percentages is kind of awkward. I couldn't figure out a better way to dynamically create an output, with the same sort of human service-y feel.
5. Ideally, I would like to develop some sort of app which could write to a database from either a phone or a computer with such information like name, time start, time end, total, signature, etc; and then have excel access that database so that a report such as this could be dynamically entered. So for instance, all I would have to do is specify I want range 7/1/2015-6/30/2016 and then a number of reports such as the one above would be generated.

Are there any other programming issues / roadblocks / limitations on the robustness of the macro / suggestions for improvement?

Answer 1

There's a lot to chew on here, so I'll grab some low hanging fruit to get things rolling.

Declarations

Multiple declarations on the same line need to have the type specified for each variable, not just the last one. This will declare mName as an Integer, but the rest are actually being declared as the fall-back Variant: Dim dValue, mIndex, mName As Integer. If you declare them on the same line and want all Integer's, you need to declare them like this:

Dim dValue As Integer, mIndex As Integer, mName As Integer

Better would be to declare them on separate lines, and right before they are used for the first time. Not only does it help you easily identify unused and undeclared variables (see below), it makes the code more maintainable by grouping everything that might be related to a code change in roughly the same place (again see below). Finally (for the purpose of this discussion), it avoids the need to scroll or even glance to the top of the procedure to see how or if a variable is declared. Doing so makes it like reading something with a ton of footnotes (headnotes?) - it interrupts the normal top down reading of the procedure. Computers are good a remembering what a ton of variable are - humans much less so.

Also, you should add Option Explicit to the top of your modules. This would point out the fact that mValue is never declared in Sub copy() (and mIndex is never used), date_next_month, last_day_month, nb_days, i, and j are not declared in Sub updateDates(), etc., etc. This can avoid a host of hard to track down bugs as well as adding the processing overhead that comes from having them implicitly created as Variant's.

---

Dates

Parsing dates with code like dValue = Int(Right(Cells(7, 1), 2)) in Sub copy() is unnecessary - you can just use the build in Month() and Day() functions...

dValue = Day(CDate(target.Cells(7, 1)))
mValue = Month(CDate(target.Cells(7, 1)))

...although just grabbing the Date itself would be the direction I'd go.

You do the same thing in Sub updateDates() with n_mValue = Int(Left(Cells(2, 26), 2)) + 1, although in that routine you can skip a bunch of the date handling. The entire first half of the Sub basically just gets you a limit to make sure that your week stays within the month. You can actually just test for the month directly in the loop and skip all of the messing around with the date. If I'm reading it correctly, you can distill the whole thing down to this:

For i = 0 To 6
    dValue = CDate(Cells(7 + i, 1)) 
    If Month(dValue) = Month(dValue + 7) Then
        Cells(7 + i, 1) = dValue + 7
    Else
        Range(Cells(7 + i, 1), Cells(7 + i, 32)).ClearContents
    End If
Next i

Note that you don't have to use the loop to wipe individual cells, and that I removed the Format call. You should generally avoid treating dates as strings except when they are going to be displayed to the user. And... Excel has a perfectly good way to do that - just set the cell format to the appropriate type and let Excel do the heavy lifting.

In Sub newMonth(mValue) you manually determine the name of the month like this (twice):

mName1 = Switch(mValue = 1, "January", mValue = 2, "February", ...

You can just use the built in MonthName() function: mName1 = MonthName(mValue).

---

Refactoring opportunities

Note the case on Selection.copy in Sub copy(). You basically get one casing for each declaration everywhere it appears in your code, so you should try to avoid collisions. This would be a great place for a more descriptive name for the Sub - something to the effect of Public Sub CopyAndFormatSheet will let Selection have its .Copy back.

Sections like this:

Columns("A:A").ColumnWidth = 6
Columns("B:B").ColumnWidth = 8
Columns("C:C").ColumnWidth = 10

...can be converted into loops so you don't have a huge wall of statements. I'd probably extract the row and column sizing to its own Sub - something like this. Note that I sized the missing rows 6, 15, and 16 - you could easily just skip them in the loop or use some other similar method, but this should at least give the gist:

Private Sub SizeRowsAndColumns(sheet As Worksheet)
    Dim widths As Variant
    widths = Array(6, 8, 10, 10, 8, 8, 6, 6, 6, 10, 10, 10, 1, 1, 5, 5, 5, _
                   5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5)

    Dim i As Long
    For i = LBound(widths) To UBound(widths)
        sheet.Columns(i + 1).ColumnWidth = widths(i)
    Next

    For i = 5 To 19
        If i = 5 Then
            sheet.Rows(i).RowHeight = 55
        ElseIf i = 14 Then
            sheet.Rows(i).RowHeight = 70
        Else
            sheet.Rows(i).RowHeight = 50
        End If
    Next
End Sub

I'd also extract a Sub to do your page setup - you generally want routines that do one thing, and one thing only. I'd also remove all of the extraneous enabling and disabling of Application.PrintCommunication - you should turn it off when you start, then on at the end. something like this:

Private Sub SetReportPageLayout(sheet As Worksheet)
    Application.PrintCommunication = False
    With sheet.PageSetup
        .PrintTitleRows = vbNullString
        .PrintTitleColumns = vbNullString
        .PrintArea = vbNullString
        .LeftHeader = vbNullString
        .CenterHeader = vbNullString
        .RightHeader = vbNullString
        .LeftFooter = vbNullString
        .CenterFooter = vbNullString
        .RightFooter = vbNullString
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = vbNullString
        .EvenPage.CenterHeader.Text = vbNullString
        .EvenPage.RightHeader.Text = vbNullString
        .EvenPage.LeftFooter.Text = vbNullString
        .EvenPage.CenterFooter.Text = vbNullString
        .EvenPage.RightFooter.Text = vbNullString
        .FirstPage.LeftHeader.Text = vbNullString
        .FirstPage.CenterHeader.Text = vbNullString
        .FirstPage.RightHeader.Text = vbNullString
        .FirstPage.LeftFooter.Text = vbNullString
        .FirstPage.CenterFooter.Text = vbNullString
        .FirstPage.RightFooter.Text = vbNullString
    End With
    Application.PrintCommunication = True    
End Sub

Note that I'd actually comb through that and remove everything that was being set to their default values too.

You should be getting and using references to your Worksheet objects, and then using them explicitly. Selection, ActiveSheet, etc. are fragile - especially with code that works with multiple sheets and ranges. They should be avoided. You should also avoid the global collections like Range, Sheets, Cells, etc. for the same reason. With the extracted Sub's and removal of the implicit and global references, you get to something much, much more readable for your main entry point. Note that the obsolete Call syntax is also removed.

Public Sub CopyAndFormatSheet()
    Dim source As Worksheet
    Dim target As Worksheet

    Set source = ActiveSheet
    With source.Parent
        Set target = .Sheets.Add(After:=.Sheets(.Sheets.Count))
    End With

    source.Range("A1:AF19").copy
    target.Paste

    SizeRowsAndColumns target
    SetReportPageLayout target
    `Another extracted sub for the Window layout here.

    'get the current date value and month value
    Dim currentDate As Date
    currentDate = CDate(target.Cells(7, 1))

    If (31 - Day(currentDate)) > 7 Then
        updateDates
    Else
        newMonth Month(currentDate)
    End If
End Sub

---

Miscellaneous

1 - You should use the built in constant vbNullString instead of the literal "". The technical reason is that compiler will actually build a copy of the literal string and store it in memory instead of using a constant null pointer. The non-technical reason is that it's considered best practice.

2 - You should also use the String returning functions (i.e. Left$) instead of the Variant returning functions (i.e. Left) unless you need a Variant (for example, to pass to a function expecting a Variant). See here for a complete list (and more detail as to why).

3 - Consider using constants instead of "magic numbers". For example, you use the number 7 extensively in your code because it's the first data row. This is much more readable because you can tell at a glance what it going on:

'Module level
Private Const FIRST_DATA_ROW = 7
Private Const DURATION_COLUMN = 7
Private Const SERVICES_COLUMN = 9

'...

'Example usage in Sub paperwork():
If (Cells(FIRST_DATA_ROW + i, DURATION_COLUMN) > 0) Then
    Cells(FIRST_DATA_ROW + i, SERVICES_COLUMN) = Int(3 * Rnd() + 1)
Else

4 - The Sum function takes an array of Range's, so if you have a contiguous range of cells to sum, just pass the whole thing at once instead of each individual cell like you do here:

If Application.WorksheetFunction.Sum(Cells(7, 7), Cells(8, 7), ... = 0 Then

This is easier to read:

If Application.WorksheetFunction.Sum(Range(Cells(7, 7), Cells(13, 7))) = 0 Then

5 - You don't need to use the Selection or Copy and Paste methods to copy data:

Range("B7:AF7").Select
Selection.copy
Range("B8").Select
ActiveSheet.Paste

You can just assign the values directly:

Range("B8:AF8").Value = Range("B7:AF7").Value

Answer 2

Thanks for the help so far! It runs much faster! New code.

Option Explicit
Sub CopyAndFormatSheet()
'copies current worksheet to a new worksheet
'
' copy Macro
'
' Keyboard Shortcut: Ctrl+d
'

    Dim source As Worksheet
    Dim target As Worksheet

    Set source = ActiveSheet
    With source.Parent
        Set target = .Sheets.Add(after:=Sheets(Sheets.Count))
    End With

    source.Range("A1:AF19").copy

    target.Paste


'copy the worksheet to a new worksheet and format it

    Call SizeRowsAndColumns(ActiveSheet)
    Call ReportPageLayout(ActiveSheet)

    Dim CurrentDate As Date
    CurrentDate = CDate(target.Cells(7, 1))

     If (31 - Day(CurrentDate)) > 7 Then
        Call updateDates
     Else
        Call newMonth(Month(CurrentDate))
     End If

End Sub

Now to format the new worksheet

Private Sub SizeRowsAndColumns(sheet As Worksheet)

    Dim widths As Variant
    widths = Array(6, 8, 10, 10, 8, 8, 6, 6, 6, 10, 10, 10, 1, 1, 5, 5, 5, _
                   5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5)

    Dim i As Long
    For i = LBound(widths) To UBound(widths)
        sheet.Columns(i + 1).ColumnWidth = widths(i)
    Next

    For i = 5 To 19
        If i = 5 Then
            sheet.Rows(i).RowHeight = 55
        ElseIf i = 6 Then
            sheet.Rows(i).RowHeight = 85
        ElseIf i = 14 Then
            sheet.Rows(i).RowHeight = 70
        ElseIf i = 15 Then
            sheet.Rows(i).RowHeight = 15
        Else
            sheet.Rows(i).RowHeight = 50
        End If
    Next

End Sub

now to format the new layout of the worksheet (so that it can be easily printed if necessarily. Question on this: how much of this is actually necessary? A lot of it was generated by recording a macro of me getting it in the proper format. Basically I'm trying to make sure the page is printer-ready (auditors/coworkers want paper copies)

Private Sub ReportPageLayout(sheet As Worksheet)

    Application.CutCopyMode = False
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = vbNullString
        .PrintTitleColumns = vbNullString
    End With

    ActiveSheet.PageSetup.PrintArea = vbNullString

    With sheet.PageSetup
        .LeftHeader = vbNullString
        .CenterHeader = vbNullString
        .RightHeader = vbNullString
        .LeftFooter = vbNullString
        .CenterFooter = vbNullString
        .RightFooter = vbNullString
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = vbNullString
        .EvenPage.CenterHeader.Text = vbNullString
        .EvenPage.RightHeader.Text = vbNullString
        .EvenPage.LeftFooter.Text = vbNullString
        .EvenPage.CenterFooter.Text = vbNullString
        .EvenPage.RightFooter.Text = vbNullString
        .FirstPage.LeftHeader.Text = vbNullString
        .FirstPage.CenterHeader.Text = vbNullString
        .FirstPage.RightHeader.Text = vbNullString
        .FirstPage.LeftFooter.Text = vbNullString
        .FirstPage.CenterFooter.Text = vbNullString
        .FirstPage.RightFooter.Text = vbNullString

    End With

    Application.PrintCommunication = True
    ActiveWindow.View = xlPageBreakPreview
    ActiveWindow.Zoom = 115
    ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
End Sub

Now to update some dates

Sub updateDates()
    Dim dValue As Date
    Dim i As Integer

    For i = 0 To 6
        dValue = CDate(Cells((7 + i), 1))
        If Month(dValue) = Month(dValue + 7) Then
            Cells(7 + i, 1) = format(dValue + 7, "mm/dd")

        Else
            Range(Cells(7 + i, 1), Cells(7 + i, 32)).ClearContents
        End If
    Next i
    Call paperwork
End Sub

Now for when there's a new month...

Sub newMonth(mValue)

    For i = 0 To 6
        Cells(7 + i, 1) = format(DateSerial(2016, mValue + 1, i + 1), "mm/dd")
    Next i

    Range("B8:AF8").Value = Range("b7:af7").Value

    'mValue is current month
    Dim mName1 As String
    Dim mName2 As String

    mName1 = MonthName(mValue)
    mName2 = MonthName(mValue + 1)

    MsgBox (mName1 & mName2)


    Selection.Replace What:=mName1, Replacement:=mName2, LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Call paperwork

End Sub

Now for filling out the service columns (placing an X where can). This was written an a new module; should I combine the two modules into one?

Option Explicit
    Private Const first_data_row = 7
    Private Const duration_column = 7
    Private Const services_column = 9


Sub paperwork()

    Dim i As Integer
    Dim j As Integer
    Dim numHabs As Integer
    Dim rando As Integer
'
' paperwork Macro
'
' Keyboard Shortcut: Ctrl+j
'

'first have to clear out anything that was previously written in the middle section
        For i = 0 To 6
                If (Cells(first_data_row + i, duration_column) > 0) Then
                    Cells(first_data_row + i, services_column) = Int(3 * Rnd() + 1)
                Else
                    Cells(first_data_row + i, services_column) = vbNullString
                End If
                Range(Cells(first_data_row + i, 10), Cells(first_data_row + i, 32)).ClearContents

        Next i

'put some new stuff in
        For i = 0 To 6
                If Cells((first_data_row + i), duration_column) > 0 Then
                    numHabs = Cells(first_data_row + i, services_column)
                    Cells(first_data_row + i, 20) = "X"
                    Cells(first_data_row + i, 25) = "X"
                End If

            While numHabs > 0
                rando = Int(3 * Rnd() + 1)
                If Cells((first_data_row + i), services_column + rando) = "" Then
                    Cells((first_data_row + i), services_column + rando) = "x"
                    numHabs = numHabs - 1
                End If
            Wend
        Next i

    Call facetoface
End Sub

Now for writing the eventual summary of work done during that period.

Sub facetoface()

    'the function takes information from the worksheet and starts assembling an output string that will eventually be placed in
    'the output box
    Dim base As String
    Dim Name() As String

    base = "Purpose and/or Response to Services Provided: "
    Name = Split(Cells(3, 4), ", ", -1)

    'generate a list of 10 pre written strings that will be randomly selected to append
    Dim Services As New Collection
    Services.Add "% of time spent working with " & Name(1) & " on developing job skills and ability to cope with the demands of the work place; "
    Services.Add "% of time spent working with " & Name(1) & " on developing soft skills and ability to speaking properly with others at the work site; "
    Services.Add "% of time spent working with " & Name(1) & " on developing good time-keeping habits; "
    Services.Add "% of time spent working with " & Name(1) & " on issues that were independently raised to me; "
    Services.Add "% of time spent working with " & Name(1) & " on arriving and leaving work properly; "
    Services.Add "% of time spent working with " & Name(1) & " to help them understand job goals at the work site; "
    Services.Add "% of time spent working with " & Name(1) & " on developing better habits; "
    Services.Add "% of time spent working with " & Name(1) & " on issues that were raised by a Medicaid Service Coordinator; "
    Services.Add "% of time spent working with " & Name(1) & " on finding new work opportunities; "
    Services.Add "% of time spent working with " & Name(1) & " on job training; "

    'generate three random integers (that collectively add up to 100) and three random integers(between 1 and 10)
    'the integers are used to select which of the statements strings added to "services" are to be selected and used for the
    'output; the numbers are used to weight each string as it comes to time spent on each task

    Dim pctTime As Integer
    Dim tempTime As Integer
    Dim tempWrk As Integer
    Dim i As Integer
    For i = 0 To 2
        If i < 2 Then
            tempTime = Round((Int(40 * Rnd() + 10) / 10), 0) * 10
            pctTime = pctTime + tempTime
        Else
            tempTime = 100 - pctTime
        End If
        tempWrk = Int(9 * Rnd() + 1)
        base = base & " " & tempTime & Services.Item(tempWrk)
        Services.Remove tempWrk
    Next i

    If Application.WorksheetFunction.Sum(Range(Cells(first_data_row, duration_column), Cells(first_data_row + 6, duration_column))) = 0 Then
        base = "Purpose and/or Response to Services Provided: " & Name(1) & " did not work during this period."
    Else
        base = Left$(base, Len(base) - 2)
    End If

    Cells(14, 1) = base

'find the range of dates for the period

    Dim dateStart As Date
    Dim dateEnd As Date

    dateStart = CDate(Cells(first_data_row, 1))

    For i = 1 To 6
        If Cells(first_data_row + i, 1).Value = vbNullString Then
            dateEnd = CDate(Cells(6 + i, 1))
            Exit For
        ElseIf i = 6 Then
            dateEnd = CDate(Cells(13, 1))
            Exit For
        End If
    Next i

    Cells(2, 26) = dateStart & "-" & dateEnd
    ActiveSheet.Name = Month(dateStart) & "." & Day(dateStart) & "-" & Month(dateEnd) & "." & Day(dateEnd)
End Sub

Firstly, thank you to @comintern for the VERY useful comments so far, and for everyone in the chat for looking at this. Firstly, you should know that as of writing this my coworker has agreed to enter in the time data on the computer. So that saves one headache.

Let me know if you'd like any updated screen shots; the screen shot hasn't changed from before.

The point of this is to generate these documents, and eventually print them, so that when the state auditors come and look at these documents they can see "oh ok work is being done as expected" and basically leave me (and my coworkers) alone. Now there are about 55 people who this needs to be done for; one of these reports per week for each person, with 8-9 people responsible for doing them regularly, makes for a lot of logistical work that's repetitive, and a ripe target for automation =).

A couple of issues conceptually: - This might need to be generated from a database in the future. So for each work period for each person, ideally, this could take up a row in the database, and then as necessary excel could access that database and make one of these reports. I've never really had experience accessing/writing to a database from excel, so any pointers on this would be very useful, and ways to initially begin with minimal database knowledge.

• The "Service Delivery" plans and the "Service Provided" plans are both randomly generated and have nothing to do with each other. Ideally I would like to develop some system by which I could classify each item; for instance, if consumer X has goal A, B, then there's something about goals A & B which show up in the service provided plan, but not C. However, at this point I do not know a way that I could classify each action taken during that period and can have excel recognize my classification scheme. So for instance:

So for instance, if 3/4 of the work done is in regards to goal 1, this should be reflected in the summary/delivery. I suppose this would require the macro to A) calculate how many x's are placed in the service delivery middle section and B) which columns they're in and C) which broad classification the goals could be classified in. I do not need help here regarding C; but A and B possible (would be nice)...

• There's also the issue of much of the data is static. For instance, start times are always set at 8:00 AM. I'd prefer it to be user generated (that's how the job coaches write it down, but it's only summed up once it gets to the office); but I don't have any working code so it's beyond the scope of code review.
• Same thing with wage information. I'd like some way to keep track of who is paid when and how much; but that's also beyond the scope of code review.