Run-time error ‘-2147467259 (80004005)’

[Daxton A.]

I have a worksheet that databases at the bottom of the worksheet by pulling all the info from the worksheet and puts each cell on the same row.
On my sheet I have the ability to select 1 of 7 options and click a button, a macro draws a circle around the active cell and bolds the font
of it. Now, when I db the worksheet, the circles get copied and stretched. So then I eliminated the circles because the text is also bold. I also
have a button that pulls all my cells from the database and puts them back onto the worksheet. I am redrawing the circles around the cell if
the

font.bold = true

The macro will run just one time and every time after that, it slings the error:

 Run-time error ‘-2147467259 (80004005)’

I learned about this error a little but none of the solutions seemed to be related to my code:

Here is a copy of my workbook...

[Paul_Hossler]

Form Controls (such as your DropDown70) are shapes, but you can't .Select them


At the right place(s) in your macro(s) try adding a test (in bold below) and bypassing at least the .Select

        For iShapes = ActiveSheet.Shapes.Count To 1 Step -1
            With ActiveSheet.Shapes(iShapes)
               
               'MsgBox (ActiveSheet.Shapes(iShapes).TopLeftCell.Address)
               
               If .Type <> msoFormControl Then

In general it's not necessary to .Select something, in oder to act on it

[Daxton A.]

That is a form of debugging/learning used while I step through the code to help visually while trying to select the correct location.

Form Controls (such as your DropDown70) are shapes, but you can't .Select them


At the right place(s) in your macro(s) try adding a test (in bold below) and bypassing at least the .Select

        For iShapes = ActiveSheet.Shapes.Count To 1 Step -1
            With ActiveSheet.Shapes(iShapes)
               
               'MsgBox (ActiveSheet.Shapes(iShapes).TopLeftCell.Address)
               
               If .Type <> msoFormControl Then

In general it's not necessary to .Select something, in oder to act on it

[Daxton A.]

Ok, it seemed to work but I don't know how to use it

For Each s In Worksheets(1).Shapes 
 If s.Type = msoFormControl Then 
 If s.FormControlType = xlCheckBox Then _ 
 s.ControlFormat.Value = False 
 End If 
Next

I found this code on the Microsoft Help Webpage, but not sure how I will get the address to logically check
for "RL" "LL" etc.

[Paul_Hossler]

Here's just one fragment of the macros

Just test the .Type of the Shape and only do the rest if it's NOT a form control

    '******************************************
    '   Clearing Circles
    '******************************************
        For iShapes = ActiveSheet.Shapes.Count To 1 Step -1
            With ActiveSheet.Shapes(iShapes)
                If .Type <> msoFormControl Then '   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
                    'MsgBox (ActiveSheet.Shapes(iShapes).TopLeftCell.Address)
                    ActiveSheet.Shapes(iShapes).Select
                    Range(ActiveSheet.Shapes(iShapes).TopLeftCell.Address).Select
                    ActiveCell.Offset(1, 1).Select
                    If ActiveCell.Text = "RL" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "LL" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "RL/RS" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "RL/LS" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "LL/LS" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "LL/RS" Then
                         ActiveCell.Font.Bold = True
                    End If
                    If ActiveCell.Text = "CL" Then
                         ActiveCell.Font.Bold = True
                    End If
                End If   '   <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
            End With
        Next iShapes

[Paul_Hossler]

Instead of messing with circles, you could use the DoubleClick event to add/remove cell borders

Because you have other borders in adjacent cells, the Add/Remove borders has to have RLTB options

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim R As Range
    
    Set R = Target.Cells(1, 1)
        
    Select Case R.Address
        Case "$K$6"
            Call RemoveBorders(Range("K7"))
            Call AddBorders(R, False)
        Case "$K$7"
            Call RemoveBorders(Range("K6"), False)
            Call AddBorders(R)
        Case "$U$6"
            Call RemoveBorders(Range("U7"))
            Call AddBorders(R)
        Case "$U$7"
            Call RemoveBorders(Range("U6"), False)
            Call AddBorders(R)
    End Select
    
End Sub

Option Explicit
Sub AddBorders(Rng As Range, Optional T As Boolean = True, Optional B As Boolean = True, Optional L As Boolean = True, Optional R As Boolean = True)
    With Rng
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        If T Then
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End If
        If B Then
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End If
        If L Then
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End If
        If R Then
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End If
    End With
End Sub

Sub RemoveBorders(Rng As Range, Optional T As Boolean = True, Optional B As Boolean = True, Optional L As Boolean = True, Optional R As Boolean = True)
    With Rng
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        If L Then .Borders(xlEdgeLeft).LineStyle = xlNone
        If T Then .Borders(xlEdgeTop).LineStyle = xlNone
        If B Then .Borders(xlEdgeBottom).LineStyle = xlNone
        If R Then .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
End Sub

[Daxton A.]

Thanks for the help everyone. I feel responsible to give the other coders name because we both created the spreadsheet. Jamie M. is a great friend and coder. I appreciate the help everyone.

[Daxton A.]

https://docs.microsoft.com/en-us/off...l.shapes.range