Change node shape colour based on text within shape

[OllieHosking]

Hello,

I have the below vba that is used to colour a smartart based on level value.
"
Sub Colour()
Dim oSA As SmartArt
Dim L As Long
'smart art must be selected!
ActiveSheet.Shapes.Range(Array("Diagram 1")).Select
Set oSA = ActiveWindow.Selection.ShapeRange(1).SmartArt
For L = 1 To oSA.AllNodes.Count
Select Case oSA.AllNodes(L).Level
Case Is = 1
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(178, 28, 26) 'Red
Case Is = 2
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(28, 95, 170) 'Blue
Case Is = 3
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(144, 168, 46) 'Green
Case Is = 4
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(230, 130, 3) 'Orange
Case Is = 5
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(250, 118, 136) 'Light pink
Case Is = 6
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(102, 178, 255) 'Light Blue
Case Is = 7
oSA.AllNodes(L).Shapes(1).Fill.ForeColor.RGB = RGB(204, 255, 153) 'Light green
'etc for other levels

End Select
Next L
End Sub
"
Which creates a hierarchy and this is one of the nodes

But I want the shape colour to be based of "CS08", with "CS08" having the possibility of being "CS01","CS02","CS03" etc, and the colour will be based of that. Sounds like a lot of case or IF statements, but i would really appreciate it as I can't find anything online!


If you need any more info or an example excel please let me know.

 

[Domenic]

Maybe something like this...

Sub test()

    Dim theSmartArt As SmartArt
    Set theSmartArt = ActiveSheet.Shapes("Diagram 1").SmartArt
   
    Dim nodeIndex As Long
    Dim nodeText As String
    For nodeIndex = 1 To theSmartArt.AllNodes.Count
        nodeText = theSmartArt.AllNodes(nodeIndex).TextFrame2.TextRange.Text
        If InStr(1, nodeText, "CS01", vbTextCompare) > 0 Then
                theSmartArt.AllNodes(nodeIndex).Shapes(1).Fill.ForeColor.RGB = RGB(178, 28, 26) 'Red
        ElseIf InStr(1, nodeText, "CS02", vbTextCompare) > 0 Then
                theSmartArt.AllNodes(nodeIndex).Shapes(1).Fill.ForeColor.RGB = RGB(28, 95, 170) 'Blue
        '
        '
        '
        End If
    Next nodeIndex
   
End Sub

Hope this helps!