2
\$\begingroup\$

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
        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.
\$\endgroup\$
2
\$\begingroup\$

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 .

\$\endgroup\$
  • \$\begingroup\$ 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!) \$\endgroup\$ – Mathieu Guindon Aug 29 '16 at 14:57
  • \$\begingroup\$ @Mat'sMug that's true, but I thought sheet was a member of some view classes ChartView, ModuleView, DialogSheetView. \$\endgroup\$ – Raystafarian Aug 29 '16 at 15:00
  • \$\begingroup\$ 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 =) \$\endgroup\$ – Mathieu Guindon Aug 29 '16 at 15:01
  • \$\begingroup\$ @Mat'sMug fair enough, I changed the argument to yours ha \$\endgroup\$ – Raystafarian Aug 29 '16 at 15:06

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.