From Work Breakdown Structure (WBS) Extract to Responsibility Assignment Matrix (RAM) Chart - How to?

[RKLLKR]

Good Morning All

I've searched the forum using Google and found two posts associated with RACI charts (aka RAM Chart), however they don't handle my situation.
I am trying to go from a Work Breakdown Structure (WBS) developed in MS Project 2010 on a Windows 7 platform to a RAM Chart in Excel 2010. The required indexing, lookups and formatting is well beyond my comfort level / skills in Excel.
Within MS Project, I develop a task list (Text) and use a number of Custom Text Fields to list the people involved in a specific role.
The extract from Project looks like this

Task Name	Responsible	Accountable	Consulted	Informed
Job 1	Bill, Mark	Susan		Joe
Job 2	Susan	Mark	Steven, Bill	Joe
Job 3	Bill	Bill	Susan	Mark
…..etc.
Job X	Steven	Mark, Susan		Bill, Joe

<tbody>
</tbody>

A properly formatted RAM Chart would look like:

Task Name	Bill	Mark	Steven	Joe	Susan
Job 1	Responsible	Responsible		Informed	Accountable
Job 2	Consulted	Accountable	Consulted	Informed	Responsible
Job 3	Accountable	Informed			Consulted
…..etc.
Job X	Informed	Accountable	Responsible	Informed	Accountable

<tbody>
</tbody>

So I’m looking for the appropriate macro (?) that:

1) Identify each individual name in the first table (R2C2:RnCn) and then place each individual as a Column Header in the RAM Chart table.
a. Condition: Row count needs to be calculated since I don’t know how long the Task Column will be for a project.
b. Condition: Ideally, cells with multiple people would be “split” / counted for how many “new” names are in the cell and each “new” name used a column header. If this can’t be accomplished then all the names in a single cell could be used as a column header. Within the original project file, there should always be at least one resource name in the Responsible column since this is field used to assign resources to the Task in MS Project. It is possible and also likely that there will be multiple names separated by a comma within Responsible. Column count in the RAM chart will be dependent on how many individual (or group) names are identified.

2) Place under each person’s name (or group of names), the appropriate role.
a. Condition: Since we haven’t settled on a standard for role names, the column count from Column B to the right-most column in the original table will be needed. Some styles of RACI charts use up to six roles.
b. Condition: Where a person is both Responsible and Accountable, the higher cell importance (Accountable) should be entered.
Since the purpose of the RAM chart is to clarify roles / responsibilities and conflicts, ideally conditional formatting would be used to identify:
Tasks where there is no designated Responsible to confirm that the Accountable is actually doing the work plus correct the original MS Project file Resource Assignment.
Tasks where there are multiple Accountable.

Extra bonus question:
If I had a properly formatted RAM Chart in Excel already, how could I go “back” to the WBS Table with Roles as Column headers and Cells containing lists of people? If a list in a single cell would be too hard, additional rows with the same Task Name (or blanked) would be useful.
Rereading this, it seems quite a wish list, but I am hoping that someone can help.
Cheers
Bob Lohmaier
Ottawa, ON

 

[MickG]

Try this, Result start "G1"
If results require modification please show Example of Data and Results with more comprehesive detail to enable correction.

[COLOR="Navy"]Sub[/COLOR] MG04Feb58
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object, Rw [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray [COLOR="Navy"]As[/COLOR] Variant, Sp [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] k [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] p [COLOR="Navy"]As[/COLOR] Variant
Ray = ActiveSheet.Range("A1").CurrentRegion
ReDim nray(1 To UBound(Ray, 1), 1 To 1)
nray(1, 1) = "Task Name"
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] Rw = 2 To UBound(Ray, 1)
     nray(Rw, 1) = Ray(Rw, 1)
        [COLOR="Navy"]For[/COLOR] Ac = 2 To UBound(Ray, 2)
            [COLOR="Navy"]If[/COLOR] Not IsEmpty(Ray(Rw, Ac)) [COLOR="Navy"]Then[/COLOR]
                Sp = Split(Ray(Rw, Ac), ",")
                [COLOR="Navy"]For[/COLOR] n = 0 To UBound(Sp)
                    [COLOR="Navy"]If[/COLOR] Not Dic.exists(Trim(Sp(n))) [COLOR="Navy"]Then[/COLOR]
                        [COLOR="Navy"]Set[/COLOR] Dic(Trim(Sp(n))) = CreateObject("Scripting.Dictionary")
                    [COLOR="Navy"]End[/COLOR] If
                    [COLOR="Navy"]If[/COLOR] Not Dic(Trim(Sp(n))).exists(Ray(Rw, 1)) [COLOR="Navy"]Then[/COLOR]
                        Dic(Trim(Sp(n))).Add (Ray(Rw, 1)), Ray(1, Ac)
                    [COLOR="Navy"]Else[/COLOR]
                        '[COLOR="Green"][B]This line will includes Multi responces i.e "Accountable" / Responcible"[/B][/COLOR]
                        '[COLOR="Green"][B]Include as required[/B][/COLOR]
                        '[COLOR="Green"][B]Dic(Trim(Sp(n))).Item(Ray(Rw, 1)) = Dic(Trim(Sp(n))).Item(Ray(Rw, 1)) & "," & Ray(1, Ac)[/B][/COLOR]
                    [COLOR="Navy"]End[/COLOR] If
                [COLOR="Navy"]Next[/COLOR] n
            [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Next[/COLOR] Rw
   
Ac = 1
ReDim Preserve nray(1 To UBound(Ray, 1), 1 To Dic.Count + 1)
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] k [COLOR="Navy"]In[/COLOR] Dic.Keys
        Ac = Ac + 1
        nray(1, Ac) = k
        [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] p [COLOR="Navy"]In[/COLOR] Dic(k)
              [COLOR="Navy"]For[/COLOR] R = 2 To UBound(nray, 1)
                    [COLOR="Navy"]If[/COLOR] nray(R, 1) = p [COLOR="Navy"]Then[/COLOR]
                       nray(R, Ac) = Dic(k).Item(p)
                       [COLOR="Navy"]Exit[/COLOR] For
                    [COLOR="Navy"]End[/COLOR] If
            [COLOR="Navy"]Next[/COLOR] R
            [COLOR="Navy"]Next[/COLOR] p
    
    [COLOR="Navy"]Next[/COLOR] k
[COLOR="Navy"]With[/COLOR] Range("G1").Resize(UBound(nray, 1), UBound(nray, 2))
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[RKLLKR]

Thanks MickG

Works like a charm. I'll be sharing this with others in my group, especially since someone just spent a bunch of effort to do this manually.

May I push my luck and your good will by asking how it could push the output into a separate worksheet in case I have sizing issues with the original table (ie it goes wider than G1)?

Cheers

Bob L

 

[MickG]

You're welcome
For Results on new sheet , change last bit of code as follows:-

With [B][COLOR=#ff0000]sheets("Sheet2").Range("A1").[/COLOR][/B]Resize(UBound(nray, 1), UBound(nray, 2))
    .Value = nray
    .Columns.AutoFit
    .Borders.Weight = 2
End With

 

[RKLLKR]

Thanks again MikeG.

Change made and your solution distributed this AM.

Cheers

Bob L

 

[MickG]

You're welcome