Get values from grouped textboxes

[RAJenson]

Hello all,

I've got a macro that takes input from a UserForm and creates a group of shapes and a textbox (a task description and a point value). The user will create multiple groups like this (it's sort of a project task list/dashboard). The code for this part of the program is here:

Private Sub CreateTask_Click()
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim blLeft As Double
Dim blTop As Double
Dim Rvalue As Integer
Dim Gvalue As Integer
Dim Bvalue As Integer
Dim Rvalueb As Integer
Dim Gvalueb As Integer
Dim Bvalueb As Integer
Dim cl As Range
Dim shp1 As Shape
Dim shp2 As Shape
Dim shp3 As Shape
If TypeName(Selection) <> "Range" Then
    Exit Sub
End If
Set cl = Range(Selection.Address)  '<-- Range("C2")
clLeft = cl.Left
clTop = cl.Top
blLeft = cl.Left + 318 - 30
blTop = cl.Top
clHeight = cl.Height
clWidth = cl.Width

If Category.Value = "Yellow" Then
    Rvalue = 255
    Gvalue = 255
    Bvalue = 102
    Rvalueb = 240
    Gvalueb = 234
    Bvalueb = 0
ElseIf Category.Value = "Green" Then
    Rvalue = 153
    Gvalue = 255
    Bvalue = 153
    Rvalueb = 153
    Gvalueb = 225
    Bvalueb = 153
ElseIf Category.Value = "Blue" Then
    Rvalue = 153
    Gvalue = 255
    Bvalue = 255
    Rvalueb = 160
    Gvalueb = 225
    Bvalueb = 250
ElseIf Category.Value = "Red" Then
    Rvalue = 255
    Gvalue = 204
    Bvalue = 204
    Rvalueb = 230
    Gvalueb = 185
    Bvalueb = 185
ElseIf Category.Value = "Violet" Then
    Rvalue = 229
    Gvalue = 204
    Bvalue = 255
    Rvalueb = 210
    Gvalueb = 185
    Bvalueb = 215
End If

Set shp1 = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, clLeft, clTop, 318, 40)
shp1.Fill.ForeColor.RGB = RGB(Rvalue, Gvalue, Bvalue)
shp1.Line.Visible = msoFalse
shp1.TextFrame.Characters.Font.ColorIndex = 1
shp1.TextFrame.VerticalAlignment = xlVAlignTop
shp1.TextFrame.HorizontalAlignment = xlHAlignLeft
shp1.TextFrame.Characters.Text = Description.Value
shp1.TextFrame.MarginRight = 30

Set shp2 = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, blLeft, blTop, 30, 20)
shp2.Fill.ForeColor.RGB = RGB(Rvalueb, Gvalueb, Bvalueb)
shp2.Line.Visible = msoFalse

Set shp3 = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, blLeft, blTop, 30, 20)
shp3.Fill.Visible = msoFalse
shp3.Line.Visible = msoFalse
shp3.TextFrame.Characters.Font.ColorIndex = 1
shp3.TextFrame.Characters.Font.Bold = True
shp3.TextFrame.Characters.Text = PointValue.Value

shp1.Name = "Descp"
shp2.Name = "PointFrame"
shp3.Name = "PointValue"

ActiveSheet.Shapes.Range(Array("Descp", "PointFrame", "PointValue")).Group
shp1.Name = "Descp1"
shp2.Name = "PointFrame1"
shp3.Name = "PointValue1"
Unload Me
End Sub

Once the user has added some of these groups, I want to get all the point values from all the shp3 textboxes in the worksheet so I can show the sum of all the points from all the current tasks. If they add or delete any of these tasks, I want to be able to update the points total. This is the part that stumps me - how do I get the values from the TextBoxes when they're all in separate Groups?

What I've tried:

Sub PointTotal()
Worksheets("Sheet2").Columns(2).Clear
    Dim tb As TextBox
    Dim ws As Worksheet
    Dim lRow As Long
    Set ws = Worksheets("Sheet2")
    
            For Each tb In ActiveSheet.TextBoxes
                lRow = ws.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
                    With ws
                        .Cells(lRow, 2).Value = tb.Text
                    End With
           Next tb
End Sub

does exactly what I want if I create individual, ungrouped TextBoxes - but it does nothing in conjunction with my code above.

Any help is greatly appreciated.
Thanks in advance,
Rob

 

[pgc01]

Hi Rob
Welcome to the board

I would loop through the shapes and if I find a group I loop through its items to find the textboxes.

This is a simple example that you can test and adapt:

' Displays the text of textboxes inside groups
Sub TextBoxInGroup()
Dim ws As Worksheet
Dim shp As Shape
Dim shpGI As Shape ' Group item

Set ws = Worksheets("Sheet2")

For Each shp In ws.Shapes
    ' if it's a group loop through its items
    If shp.Type = msoGroup Then
        For Each shpGI In shp.GroupItems
            ' if the group item is a textbox display its text
            If shpGI.Type = msoTextBox Then
                MsgBox shpGI.TextFrame2.TextRange.Text
            End If
        Next shpGI
    End If
Next shp

End Sub

 

[RAJenson]

PGC, that did exactly what I needed it to do. Thanks so much for your help!

 

[pgc01]

You're welcome. Thanks for the feedback.