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.