Macro Summary and Renaming

mrerer

New Member
Joined
Mar 10, 2016
Messages
18
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 SOWTotal Hours
Consultant8.0
Consultant8.0
Consultant4.0
Consultant20.0
WIM Consultant26.0
Consultant24.0
Consultant4.0
WIM Consultant16.0
Consultant8.0
Consultant40.0
Practice Director20.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:
ServicesHours
Consultant40
WIM Consultant118
Practice Director20

<tbody>
</tbody>

The above VBA summary is incorrect as it should be:
ServicesHours
Consultant116
WIM Consultant42
Practice Director20

<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
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,846
Office Version
  1. 2019
Platform
  1. Windows
Why go through doing this with VBA when you can do it in seconds with a Pivot Table.

vABCDEFG
1Role Description for SOWTotal HoursRow LabelsSum of Total Hours
2Consultant8Consultant116
3Consultant8Practice Director20
4Consultant4WIM Consultant42
5Consultant20Grand Total178
6WIM Consultant26
7Consultant24
8Consultant4
9WIM Consultant16
10Consultant8
11Consultant40
12Practice Director20
 
Last edited:

mrerer

New Member
Joined
Mar 10, 2016
Messages
18
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

Well-known Member
Joined
Feb 26, 2007
Messages
5,846
Office Version
  1. 2019
Platform
  1. Windows
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.

Code:
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

New Member
Joined
Mar 10, 2016
Messages
18
Thank you Alan, much appreciated and it has worked great cleaning up my mess for now!

Best,
Matt
 

Watch MrExcel Video

Forum statistics

Threads
1,108,574
Messages
5,523,677
Members
409,531
Latest member
wo1f

This Week's Hot Topics

Top