Toggle Button Code making copies of button in error

[SlinkRN]

Good morning! I have an Excel Workbook that is shared and I created a Toggle button that users can click to signify that the workbook is currently being used and others should wait until the toggle button turns green. Unfortunately, somehow the shape automatically is being copied and pasted on top of the current shape occasionally which makes the toggle button not function until I delete the copies. It only happens sometimes, so I'm wondering if 2 users click on the button at the same time it makes that copy. Can anyone see why the copy is being pasted over the shape? Here is the code:

Sub Toggle()

If Range("ToggleActive") = 0 Then

ActiveSheet.Shapes.Range(Array("CodeActive")).Select

With Selection.ShapeRange.Fill

.Visible = msoTrue

.ForeColor.RGB = RGB(255, 51, 51)

.Transparency = 0

.Solid

End With

Sheets("Main").Unprotect "password"

Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _

"Someone is using functions (clicking on name or using buttons) right now - please wait."

Sheets("Main").Protect "password"

Range("ToggleActive") = 1

Exit Sub

End If


If Range("ToggleActive") = 1 Then

ActiveSheet.Shapes.Range(Array("CodeActive")).Select

With Selection.ShapeRange.Fill

.Visible = msoTrue

.ForeColor.RGB = RGB(45, 134, 45)

.Transparency = 0

.Solid

End With

Sheets("Main").Unprotect "password"

Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _

"Nobody is using functions (clicking on name or using buttons) right now - please click this button to notify others before using functions."

Sheets("Main").Protect "password"

Range("ToggleActive") = 0

End If

End Sub

 

[sijpie]

In theory, as far as I see, the code should do the trick. But I notice the code selects the button, which means that it will end up with the little 'selected' circles. Although the sheet becomes protected, I don't know what that does.

I would stay away from selecting the button, there is no need, and it is also relatively slow.

Just tell what you want to do with the shape without selecting (see code below) or, deselect it at the end of the code

Sub Toggle()

    Sheets("Main").Unprotect "password"
    If Range("ToggleActive") = 0 Then
        'set to green and sheet is free
        With ActiveSheet.Shapes.Range(Array("CodeActive"))
            With .ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 51, 51)
                .Transparency = 0
                .Solid
            End With
            
            .ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            "Someone is using functions (clicking on name or using buttons) right now - please wait."
        End With
            
        Range("ToggleActive") = 1
        
    ElseIf Range("ToggleActive") = 1 Then
        'set to red and sheet is being used
        With ActiveSheet.Shapes.Range(Array("CodeActive"))
            With .ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(45, 134, 45)
                .Transparency = 0
                .Solid
            End With
        
            .ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            "Nobody is using functions (clicking on name or using buttons) right now - please click this button to notify others before using functions."
        End With
        
        Range("ToggleActive") = 0
    
    End If
    Sheets("Main").Protect "password"

End Sub

 

[SlinkRN]

In theory, as far as I see, the code should do the trick. But I notice the code selects the button, which means that it will end up with the little 'selected' circles. Although the sheet becomes protected, I don't know what that does.

I would stay away from selecting the button, there is no need, and it is also relatively slow.

Just tell what you want to do with the shape without selecting (see code below) or, deselect it at the end of the code

Sub Toggle()

    Sheets("Main").Unprotect "password"
    If Range("ToggleActive") = 0 Then
        'set to green and sheet is free
        With ActiveSheet.Shapes.Range(Array("CodeActive"))
            With .ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 51, 51)
                .Transparency = 0
                .Solid
            End With
           
            .ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            "Someone is using functions (clicking on name or using buttons) right now - please wait."
        End With
           
        Range("ToggleActive") = 1
       
    ElseIf Range("ToggleActive") = 1 Then
        'set to red and sheet is being used
        With ActiveSheet.Shapes.Range(Array("CodeActive"))
            With .ShapeRange.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(45, 134, 45)
                .Transparency = 0
                .Solid
            End With
       
            .ShapeRange(1).TextFrame2.TextRange.Characters.Text = _
            "Nobody is using functions (clicking on name or using buttons) right now - please click this button to notify others before using functions."
        End With
       
        Range("ToggleActive") = 0
   
    End If
    Sheets("Main").Protect "password"

End Sub

Thanks so much Sigpie! I did discover some change code on the sheet that might have been making the copy and that seems to have fixed my issue but I am very grateful for you advice on the Select issue. I must admit I have a habit of doing that when things aren't working right off. I will definitely adjust my code to fix that. I appreciate the help!! Slink