4
\$\begingroup\$

This is probably my final submission to Code Review regarding this making a report from payroll details series. Basically, working in the human services sector, the funding agency requires A) Weekly documentation of services provided and B) Monthly documentation of general progress for each of 60+ developmentally disabled individuals. The paperwork sucks so it's time to automate it. This is the monthly documentation.

The macro takes user inputted information in worksheet monthly (cells F, G, H), runs it through some comparisons and aggregations, and puts together a string based on data located in some other worksheets (skills, progress, treatment). It then places the output in the 9th column of that row. Eventually it's in the format of being easy to output through a mail merge in microsoft word. So as long as there are 1000+ rows of data, it would be easy to make 1000 reports in printer ready format.

thank you @mats mug, @Comintern, and @raystafarian for the previous help

Edit: SkillRating type included

  Option Explicit
Public Sub main()
    CheckSpreadsheet

End Sub
Private Sub CheckSpreadsheet()
'checks the spreadsheet
'based on the current row being analyzed, finds the previous row where their name occured
'sets the current row and the offset row

    Dim checkName As String
    Dim j As Long
    Dim i As Long
    Dim totalRow As Long

    totalRow = Range("A1").End(xlDown).row


    'first scan all the values in column 1
    For i = 2 To totalRow
        checkName = Cells(i, 1)
            For j = i - 1 To 1 Step -1
                     If Cells(j, 1) = checkName Then
                        BeginWriting i, j
                        Exit For

                    Else
                        Cells(i, 9) = "There is no data from previous months upon which to compare"
                    End If
            Next j
    Next i


End Sub
Private Sub BeginWriting(CurrentRow As Long, OffsetRow As Long)
'takes the current row, and the previous row which has the same string in column A
'starts putting together the output (eventually to take place in column 9)


    Dim i As Long
    Dim Consumer As TConsumer

    Consumer.Name = Cells(CurrentRow, 1)
    Consumer.Month = Cells(CurrentRow, 2)
    Consumer.Year = Cells(CurrentRow, 3)
    Consumer.TABS = Cells(CurrentRow, 4)
    Consumer.Medicaid = Cells(CurrentRow, 5)
    Consumer.SoftSkills = Cells(CurrentRow, 6)
    Consumer.JobSkills = Cells(CurrentRow, 7)
    Consumer.TimeSkills = Cells(CurrentRow, 8)

    'initialize output string
    Consumer.Output = Consumer.Name & "'s service delivery employment plan for " & Consumer.Month & " " & Consumer.Year _
    & " included implementation with soft skills, job skills, and time skills. "

    Dim data As ListObject
    Set data = Sheets("TableSkills").ListObjects("SkillRating")



    Consumer.Output = Consumer.Output & Replace(data.ListRows(Consumer.SoftSkills + 1).Range(ColumnIndex:=2) & _
                                                data.ListRows(Consumer.JobSkills + 1).Range(ColumnIndex:=3) & _
                                                data.ListRows(Consumer.TimeSkills + 1).Range(ColumnIndex:=4), "%NAME%", Consumer.Name)

  ' moving into progress stage...
    Consumer.Output = Consumer.Output & " In terms of progress this month,"

    Dim progress As Long
    Dim skillsProgress As Dictionary

    Set skillsProgress = New Dictionary

    For i = 0 To 2
        progress = Cells(CurrentRow, 6 + i) - Cells(OffsetRow, 6 + i)
        skillsProgress.Add Cells(1, 6 + i), progress

    Next i



    Consumer.Output = Consumer.Output & FindProgress(skillsProgress, Consumer)
    Consumer.Output = Consumer.Output & FindIssue(skillsProgress, Consumer)

   Cells(CurrentRow, 9) = Consumer.Output


End Sub

Public Function FindIssue(skillsProgress As Dictionary, Consumer As TConsumer) As String
'to find out which category accounts for the least part of the change from the previous month

    Dim progress As String
    Dim overallProgress As Long
    Dim i As Long
    Dim data As ListObject

    Set data = Sheets("Treatment").ListObjects("Treatment")

    Dim numberOfTreatment As Long
    Dim treatmentApplied As Long

    'find out which treatments to apply
    'only apply a treatment if progress is either at 0 or negative

    For i = 0 To 2
        If skillsProgress.Items()(i) < 0 Then
            progress = progress & Consumer.Name & " showed a decline in " & skillsProgress.Keys()(i) & " this month. "
            numberOfTreatment = data.ListColumns(i + 1).Range.End(xlDown).row - 1
            treatmentApplied = CInt((Rnd() * numberOfTreatment) + 1)
            progress = progress & Replace(data.ListRows(treatmentApplied).Range(ColumnIndex:=(2 + i)), "%NAME%", Consumer.Name) & " Going forward, working on " _
                                         & Consumer.Name & "'s " & skillsProgress.Keys()(i) & " will be a priority."


        ElseIf skillsProgress.Items()(i) = 0 Then
            progress = progress & Consumer.Name & " showed no change in " & skillsProgress.Keys()(i) & " this month. "
            numberOfTreatment = data.ListColumns(i + 1).Range.End(xlDown).row - 1
            treatmentApplied = CInt((Rnd() * numberOfTreatment) + 1)
            progress = progress & Replace(data.ListRows(treatmentApplied).Range(ColumnIndex:=(2 + i)), "%NAME%", Consumer.Name) & " Going forward, working on " _
                                         & Consumer.Name & "'s " & skillsProgress.Keys()(i) & " will be a priority."
        Else
        End If
    Next i


    FindIssue = progress


End Function
Public Function FindProgress(skillsProgress As Dictionary, Consumer As TConsumer) As String
'takes the progress

    Dim progress As String
    Dim overallProgress As Long
    Dim data As ListObject

    Set data = Sheets("Progress").ListObjects("Progress")

    Dim i As Long

    'first find the progress in each individual category
    'turn it into a string
    'string derived from worksheet "Progress"
    For i = 0 To 2
        overallProgress = overallProgress + skillsProgress.Items()(i)
        If skillsProgress.Items()(i) > 0 Then
             progress = progress & Replace(data.ListRows(3).Range(ColumnIndex:=(2 + i)), "%NAME%", Consumer.Name)
        ElseIf skillsProgress.Items()(i) < 0 Then
             progress = progress & Replace(data.ListRows(1).Range(ColumnIndex:=(2 + i)), "%NAME%", Consumer.Name)
        Else
             progress = progress & Replace(data.ListRows(2).Range(ColumnIndex:=(2 + i)), "%NAME%", Consumer.Name)
        End If
    Next i

    'next find the overall progress
    'turn it into a string
    'string derived from worksheet "Progress"
    If overallProgress > 0 Then
            progress = progress & Replace(data.ListRows(3).Range(ColumnIndex:=(5)), "%NAME%", Consumer.Name)
    ElseIf overallProgress < 0 Then
            progress = progress & Replace(data.ListRows(1).Range(ColumnIndex:=(5)), "%NAME%", Consumer.Name)
    ElseIf overallProgress = 0 Then
            progress = progress & Replace(data.ListRows(2).Range(ColumnIndex:=(5)), "%NAME%", Consumer.Name)
    End If


    FindProgress = progress
End Function

TConsumer Data Type

    Option Explicit

    Public Type TConsumer
        Name As String
        Output As String
        progress As String
        Month As String
        Year As Long
        TABS As String
        Medicaid As String
        JobSkills As SkillRating
        TimeSkills As SkillRating
        SoftSkills As SkillRating
    End Type

Type SkillRating

Option Explicit

Public Enum SkillRating
    NotApplicable
    Minimal
    Low
    Medium
    High
    Master
End Enum

Monthly worksheet enter image description here

Table skills worksheet / table skills table enter image description here

progress worksheet/ progress table enter image description here

treatment worksheet/treatment table enter image description here

\$\endgroup\$
  • \$\begingroup\$ @Raystafarian Previously the ByVal arguments were needed because I was using an object. However, mats mug showed me that I did not need to use an object, rather I could use a "type", which doesn't dynamically generated a new object but is rather a static holder of logically connected variables. So in this version the byVal arguments that were previously associated with the consumer class are not included, and the code as written seems to run fine. \$\endgroup\$ – bdpolinsky Sep 1 '16 at 20:10
  • \$\begingroup\$ Ah, right. It wouldn't break \$\endgroup\$ – Raystafarian Sep 1 '16 at 20:11
  • \$\begingroup\$ what may have been confusing is that I did not include skillRating type. So the skillRating in TConsumer might have been referencing something unknown. It is now included. \$\endgroup\$ – bdpolinsky Sep 1 '16 at 20:14
  • \$\begingroup\$ I don't know why this has sat so long, maybe because a lot of us already answered a previous version? Anyway, commenting to maybe bump this up to the active queue. \$\endgroup\$ – Raystafarian Sep 6 '16 at 18:54
0
\$\begingroup\$

Just a quick run through with RubberDuck VBA shows two common issues -

Passing arguments ByRef. You want to pass them ByVal if at all possible, and it's possible on these.

enter image description here

And not qualifying explicit references. When you refer to Sheet or Range or Cell it is assuming ActiveSheet unless you tell it otherwise. Always tell it where to look.

enter image description here


If this code here -

totalRow = Range("A1").End(xlDown).Row

Is getting the last row, there is a standard way to find lastRow and lastColumn. That post explains why.

You also have a lot of comments. Do you really need those? If so, why? Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

\$\endgroup\$

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.