0

I am recieving an error when I attempt to run this program. It is a userform which pops up from double clicking a shape in excel. The userform allows u to change the status of the box from normal to "in progress" to "done". This change creates a box inside the original and adds a border as shown.enter image description here

This works fine the first time you change. But once you change the status to in prog or done you cannot change it again or you receive the following error: enter image description here

I was able to repeatedly change the status by using two buttons but once I merged into a combobox in the userform I started experiencing this the code is shown below for the Userform and the line where the error occurs will be bolded. Thanks in advance for the help.

  Private Sub UserForm_Initialize()

'fill combobox catagory
Me.cmbCAT.AddItem "L1U"
Me.cmbCAT.AddItem "L1L"
Me.cmbCAT.AddItem "IN"
Me.cmbCAT.AddItem "SC"
Me.cmbCAT.AddItem "GE"
Me.cmbCAT.AddItem "TE"
Me.cmbCAT.AddItem "ExD"


'fill combobox resources
Me.cmbResource.AddItem "Item1"
Me.cmbResource.AddItem "Item2"

'fill combobox Status
Me.cmbStatus.AddItem ""
Me.cmbStatus.AddItem "In Prog"
Me.cmbStatus.AddItem "Done"

End Sub

Private Sub btnSubmit_Click()

Dim AShape As Shape
Dim USelection As Variant
Dim ShapeArray(0 To 1) As String
Dim ShapeArr(0 To 1) As String


        'Pull-in what is selected on screen
Set USelection = ActiveWindow.Selection

        'Determine if selection is a shape
Set AShape = ActiveSheet.Shapes(Sheet4.Range("B1"))



If cmbCAT.Text = "L1U" Then
   ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 180, 18)
ElseIf cmbCAT.Text = "L1L" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf cmbCAT.Text = "SC" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(147, 196, 22)
ElseIf cmbCAT.Text = "IN" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 255, 70)
ElseIf cmbCAT = "GE" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(255, 173, 203)
ElseIf cmbCAT = "TE" Then
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(114, 163, 255)
Else
    ActiveSheet.Shapes(Sheet4.Range("B1")).Fill.ForeColor.RGB = RGB(159, 2, 227)
End If

Sheet4.Range("A3").Value = tbSP.Value
Sheet4.Range("A4").Value = tbDROP.Value
Sheet4.Range("A5").Value = cmbCAT.Text
Sheet4.Range("A6").Value = tbUS.Value
Sheet4.Range("A7").Value = tbTITLE.Text
Sheet4.Range("A8").Value = cmbResource.Text
Sheet4.Range("A9").Value = tbDES.Text
Sheet4.Range("A10").Value = cmbStatus.Text



ActiveSheet.Shapes(Sheet4.Range("B1")).TextFrame.Characters.Caption = tbSP & "-" & tbDROP & "." & cmbCAT & "." & tbUS & vbNewLine & _
"Resource: " & cmbResource & vbNewLine & _
"Description: " & tbDES & vbNewLine


'Update if status is "In progress"

If Sheet4.Range("A10") = "In Prog" Then
    With ActiveSheet.Shapes(Sheet4.Range("B1")).line
        .Weight = 5
        .ForeColor.RGB = RGB(2, 199, 6)
    End With

    Dim Box1 As Shape
    Set Box1 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveSheet.Shapes(Sheet4.Range("B1")).Left + ActiveSheet.Shapes(Sheet4.Range("B1")).Width - 50, ActiveSheet.Shapes(Sheet4.Range("B1")).TOP + ActiveSheet.Shapes(Sheet4.Range("B1")).Height - 20, 50, 20)

    Box1.Fill.ForeColor.RGB = RGB(2, 199, 6)
    Box1.OLEFormat.Object.Caption = "In Prog"

                'Group the two boxes together



    ShapeArray(0) = Box1.Name
    ShapeArray(1) = ActiveSheet.Shapes(Sheet4.Range("B1")).Name

    **ActiveSheet.Shapes.Range(Array(ShapeArray(0), ShapeArray(1))).Group**

'Update if Status is "done"
ElseIf Sheet4.Range("A10") = "Done" Then
     With ActiveSheet.Shapes(Sheet4.Range("B1")).line
        .Weight = 5
        .ForeColor.RGB = RGB(61, 134, 212)
    End With

    Dim Box2 As Shape
    Set Box2 = Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, ActiveSheet.Shapes(Sheet4.Range("B1")).Left + ActiveSheet.Shapes(Sheet4.Range("B1")).Width - 50, ActiveSheet.Shapes(Sheet4.Range("B1")).TOP + ActiveSheet.Shapes(Sheet4.Range("B1")).Height - 20, 50, 20)

    Box2.Fill.ForeColor.RGB = RGB(61, 134, 212)
    Box2.OLEFormat.Object.Caption = "Done"

                   'Group the two boxes together




    ShapeArr(0) = Box2.Name
    ShapeArr(1) = ActiveSheet.Shapes(Sheet4.Range("B1")).Name

    **ActiveSheet.Shapes.Range(Array(ShapeArr(0), ShapeArr(1))).Group**





End If

Unload UF2

End Sub

It seems the array is not being setup right. Does this have to do with the original shape already being in a group? I tried ungrouping but this causes another error for the first time status change as it ungroup the shape but it hasn't belonged to a group yet. I didn't experience this when i used two separate buttons to change status.

Ammar Ahmad
  • 41
  • 9
  • Have you tried [stepping through the code](http://www.cpearson.com/excel/DebuggingVBA.aspx)? You can use the locals window (View >> Locals Window) to check values held in `ShapeArr` at various points during execution. This should help narrow down the error. – David Rushton Jan 24 '18 at 17:17
  • Great suggestion I just did that. I created a shape and changed the status to "In Prog" and "Done", ShapeArray seems to have both shape names stored as ShapeArray(0) = "TestBox86" and ShapeArray(1) = "Rectangle83". But the error persists that Shape Range object must include two items. Not sure why. – Ammar Ahmad Jan 24 '18 at 17:27
  • See if this link can help you, specifically the accepted answer referencing `Application.Transpose`. https://stackoverflow.com/questions/33161371/writing-an-array-to-a-range-only-getting-first-value-of-array?answertab=votes#tab-top – TotsieMae Jan 24 '18 at 22:20
  • I tried transposing the array, not sure why that would matter because I am not printing it onto a column but i did it anyways, the problem persists. Any more suggestions would be appreciated – Ammar Ahmad Jan 29 '18 at 20:11

0 Answers0