Making a report from payroll details part II

Thanks for the help so far! Especially all of the people who helped out on part I - seen here. Making a report from payroll details

Here's the revisions to the code based on feedback from that thread. The goals of this code are to take payroll details in spreadsheet format, and to make a properly formatted report that can be consistently generated across weeks, months, and years, that contains time information as well as progress notes. This is for use in the human services sector, and writing up the progress of the individuals with Developmental Disabilities. Note: if you're looking for a screen shot, there should be screen shots in the link.

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
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
.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)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintGridlines = False
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.EvenPage.LeftFooter.Text = vbNullString
.EvenPage.CenterFooter.Text = vbNullString
.EvenPage.RightFooter.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. 1 Answer First, in newMonth you didn't define i so it won't compile with Option Explicit. What's the order? Let's take a look at the structure of your procedures. 1. First things first, you don't need to Call subs, it's obsolete. Instead just use Sub argument, argument 2. So there's a Public Sub CopyAndFormatSheet that • Calls private SizeRowsAndColumns • Calls private ReportPageLayout 3. Then, we have a split, either • Call Public UpdateDates then call public paperwork • OR • Call Public newMonth then call public paperwork 4. But paperwork always calls Public facetoface Too many exits, I think. How will you handle errors? I'd go with a main Public Sub MainControl() CopyAndFormatSheet SizeRowsAndColumns ActiveSheet ReportPageLayout ActiveSheet DetermineDate targetSheet 'New paperwork facetoface End Sub Private Sub DetermineDate(byVal targetSheet as Worksheet) Dim myDate as Date myDate = CDate(targetSheet.Cells(7, 1)) If (31 - Day(myDate)) > 7 Then updateDates Else newMonth (Month(CurrentDate)) End If End Sub  See, now we don't need to go to any other routine or function except from the main function or the DetermineDate function which will allow you to catch errors all in the MainControl And everything except MainControl can be Private. Also, you can pass all your arguments ByVal rather than the default ByRef. Also, now maybe you can utilize some Functions to return values like the targetSheet back to the MainControl. Naming Your routine names are all over the place with capitalization. You're doing good PascalCase until updateDates and newMonth and then you lose it all together on paperwork and facetoface. Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names. Additionally, constants are to be CAPITAL_SNAKEY_CASE: Private Const FIRST_DATE_ROW As Long = 7 Private Const DURATION_COLUMN As Long = 7 Private Const SERVICES_COLUMN As Long = 9  You'll see I also cast them with a type. "Long?" you say? Yes! Integers - integers are obsolete. According to msdn VBA silently converts all integers to long. You can convert all of your integers to Long too! Your variable naming can be improved for some clarity • source - sourceSheet • target - targetSheet • CurrentDate - currentDate • widths - columnWidths • dValue - what is this? the date value of the date you pass through the (now) splitting function? You can do better than dValue • mName1 and mName2 - if you're numbering your variables, the names aren't descriptive enough. What? currentMonth and nextMonth? Or targetMonth and nextMonth? Something. • numHabs - what? What is that? • rando - huh? randomAdditionColumn? • Name() - arrayOfNames() • Services - not too specific. workServices • pctTime - timePercentage • tempTime - timeOnTemporaryAssignment • tempWrk - temporaryAssignment • dateStart and dateEnd are all right, but what are they the start and end of? base - What is base doing? Dim base As String base = "Purpose and/or Response to Services Provided: " base = base & " " & tempTime & Services.Item(tempWrk) If this base = "Purpose and/or Response to Services Provided: " & Name(1) & " did not work during this period." Else: base = Left$(base, Len(base) - 2)
Cells(14, 1) = base


I'm not sure and the name is pretty ambiguous.

Private Sub SizeRowsAndColumns(sheet As Worksheet)


I'd avoid ambiguous names like sheet - maybe it's mySheet or (better yet) targetSheet instead?

You're using ActiveSheet which, in my opinion, is like using Select. Be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this - https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros .

• I don't think sheet is reserved. Sheets is a global collection, and the class would be Worksheet - IMO mySheet isn't much better either, best use a name that tells us what it's used for - targetSheet for example. Nice answer though (as always!) – Mathieu Guindon Aug 29 '16 at 14:57
• @Mat'sMug that's true, but I thought sheet was a member of some view classes ChartView, ModuleView, DialogSheetView. – Raystafarian Aug 29 '16 at 15:00
• Bah, it's not much different than having a ByVal value parameter for Property Let members of a class, when Value exists as a member of Range - different scope, no overlaps, no harm imo =) – Mathieu Guindon Aug 29 '16 at 15:01
• @Mat'sMug fair enough, I changed the argument to yours ha – Raystafarian Aug 29 '16 at 15:06