Macro Summary and Renaming

[mrerer]

Hello all,
I have an odd scenario that has just happened to me for the first time with an existing file and macro I have used for some time now. This code was compiled over some versions of the file, but I am not able to reason out this piece and what it is resulting as.

Okay, here is my data below from my RLws tab:

Role Description for SOW	Total Hours
Consultant	8.0
Consultant	8.0
Consultant	4.0
Consultant	20.0
WIM Consultant	26.0
Consultant	24.0
Consultant	4.0
WIM Consultant	16.0
Consultant	8.0
Consultant	40.0
Practice Director	20.0

<tbody>
</tbody>

And here is my VBA code to summarize this data...among some other actions, but the summary is my issue:
'Copy RL worksheet values to the Financial Summary Worksheet
'Begin Change
For Each resource In RLws.Range("B5:B" & LCell)
ResourceRow = resource.Row
NextRow = Fws.Cells(Fws.Rows.Count, "A").End(xlUp).Row + 1
RoleDescription = RLws.Range("B" & ResourceRow).Value


RoleDescription = RLws.Range("B" & ResourceRow).Value
If (RoleDescription Like "*Project*") Then
RoleDescription = "Project Management"
End If

Set ExistingService = Fws.Range("A9:A" & NextRow).Cells.Find(RoleDescription)

Set ExistingService = Fws.Range("A5:A" & NextRow).Cells.Find(RoleDescription)
If (ExistingService Is Nothing) Then
Fws.Range("A" & NextRow) = RoleDescription
Fws.Range("A" & NextRow).VerticalAlignment = xlCenter
Else
NextRow = ExistingService.Row
End If

Fws.Range("B" & NextRow).Value = Format(Fws.Range("B" & NextRow).Value + RLws.Range("DG" & ResourceRow).Value, "#,##0")
Next resource
'End Change

But, here is the catch, the following is the summation, which is incorrect. I believe my 'RoleDescription' is combining incorrect roles and resulting in bad data:

Services	Hours
Consultant	40
WIM Consultant	118
Practice Director	20

<tbody>
</tbody>

The above VBA summary is incorrect as it should be:

Services	Hours
Consultant	116
WIM Consultant	42
Practice Director	20

<tbody>
</tbody>

CAN ANYBODY SEE WHAT I HAVE GOING ON INCORRECTLY HERE THAT MY MACRO IS RE SUMMARIZING ROLES(ALBEIT SIMILAR ONES) AND APPLYING INCORRECT HOUR AMOUNTS ???

Thank you much!
Matt

 

[alansidman]

Why go through doing this with VBA when you can do it in seconds with a Pivot Table.

v	A	B	C	D	E	F	G
1	Role Description for SOW	Total Hours				Row Labels	Sum of Total Hours
2	Consultant	8				Consultant	116
3	Consultant	8				Practice Director	20
4	Consultant	4				WIM Consultant	42
5	Consultant	20				Grand Total	178
6	WIM Consultant	26
7	Consultant	24
8	Consultant	4
9	WIM Consultant	16
10	Consultant	8
11	Consultant	40
12	Practice Director	20

 

[mrerer]

Why no pivot?
Because it is a legacy report used by an audience that is more accepting of hard coded data summary versus pivots...this does that for us nicely.
Also, there is language to change certain roles naming to display as something else.

Just curios if there was an obvious thing there in the code is all.

Thanks much tho!

 

[alansidman]

Do you have more than the three categories shown in your example or are these the only three?

If only the Three, then here is alternate code. Yours was missing some clear definitions and I could not determine what your some of your variables were as you provided only partial code. This is a bit clunky, but it works.

Option Explicit


Sub Ffoo()
'In this scenario, assumes your data is in cells A1:B12
    Dim lr As Long, lr2 As Long, i As Long
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    Set s1 = Sheets("RLws")
    Set s2 = Sheets("Fws")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    Dim x As Long
    x = 0
    For i = 2 To lr
        If s1.Range("A" & i) = "Consultant" Then
            x = x + s1.Range("B" & i)
        End If
    Next i
    lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
    s2.Range("A" & lr2 + 1) = "Consultant"
    s2.Range("B" & lr2 + 1) = x
    x = 0
    For i = 2 To lr
        If InStr(1, s1.Range("A" & i), "WIM Consultant") > 0 Then
            x = x + s1.Range("B" & i)
        End If
    Next i
    lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
    s2.Range("A" & lr2 + 1) = "WIM Consultant"
    s2.Range("B" & lr2 + 1) = x
    x = 0
    For i = 2 To lr
        If InStr(1, s1.Range("A" & i), "Practice Director") > 0 Then
            x = x + s1.Range("B" & i)
        End If
    Next i
    lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
    s2.Range("A" & lr2 + 1) = "Practice Director"
    s2.Range("B" & lr2 + 1) = x
End Sub

 

[mrerer]

Thank you Alan, much appreciated and it has worked great cleaning up my mess for now!

Best,
Matt