VBA Runtime Error when Selecting Dropdown List

[Tigron]

Hello community,

first of all I'd like to note, that I am a complete noob when it comes to VBA. Unlike other programming languages such as HTML, CSS or even Python, VBA doesn't really "speak with me", which makes finding a solution - or just even playing around with the code - pretty difficult. I feel "a tiny bit" overwhelmed.

I am working on a trading journal in Excel (I trade cryptocurrencies) and found a solution to an issue I had. I wanted to be able to put long notes on my individual trades in a very small cell and, when reviewing my trades in retrospect, be able to "hover over" that cell and have a pop-up appear with the complete text. I found a great solution here: Link

The problem with this solution is that, whenever I select a cell that contains a dropdown list, I get a VBA runtime error. Please view screen shots for the exact message.

The code I am using looks like this:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Const SHAPENAME As String = "MessageShape"
    Dim ws As Worksheet
    Dim oshp As Shape
    Dim icount As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim iHeight As Integer
    Dim iWidth As Integer
    
    Set ws = ActiveSheet
    
    'Only run if one cell is selected
    If Target.Count > 1 Then Exit Sub
    
    'Delete any existing shapes. We run though all shapes backwards
    For icount = ws.Shapes.Count To 1 Step -1
        Set oshp = ws.Shapes(icount)
        If (oshp.Name = SHAPENAME) Then
            oshp.Delete
        End If
    Next icount
    
    'Lets grab the position of the selected cell, we'll use this to place the message box just to the right of it.
    'We add 5 to the position to give it a pleasant offset
    iX = Target.Cells(1, 2).Left + 5
    iY = Target.Top + 5
    iHeight = 200 'Adjust the box height by changing this
    iWidth = 450 'Adjust the box widthby changing this
    
    'Show the message box - Amend this if you want to change the position
    Select Case Target.Column
            Case 21, 32, 37 'Add column numbers here
            Set oshp = ws.Shapes.AddTextbox(msoTextOrientationHorizontal, iX, iY, iWidth, iHeight)
            oshp.TextFrame2.TextRange.Characters.Text = Target.Value
            oshp.Name = SHAPENAME
    End Select

End Sub

Can someone explain what is going wrong here and how to solve this issue. You would make me a immensely happy camper.
One last thing: I would also like to change the background color and the font color of the pop-up, but I have no idea as to where I have to paste the code.

Thanks in advance for any help you can provide!

 

[lrobbo314]

Sure thing. Anytime.

 

[Tigron]

@irobbo314: Just a somewhat amusing side note. I just asked ChatGPT to add a font size of 14 to your code. I gave ChatGPT the whole code and asked it to complete the code. What can I say? It worked. ...we live in interesting times...

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    Const SHAPENAME As String = "MessageShape"
    Dim ws As Worksheet
    Dim oshp As Shape
    Dim icount As Integer
    Dim iX As Integer
    Dim iY As Integer
    Dim iHeight As Integer
    Dim iWidth As Integer
    Dim shx As Shape

    Set ws = ActiveSheet

    For Each shx In ws.Shapes
        If shx.Name = SHAPENAME Then shx.Delete
    Next shx

    iX = Target.Cells(1, 2).Left + 5
    iY = Target.Top + 5
    iHeight = 200
    iWidth = 450

    If Not IsEmpty(Target.Value) Then
        Select Case Target.Column
            Case 21, 32, 37
                With ws.Shapes.AddTextbox(msoTextOrientationHorizontal, iX, iY, iWidth, iHeight)
                    .TextFrame2.TextRange.Characters.Text = Target.Value
                    .TextFrame.Characters.Font.Size = 14
                    .TextFrame.Characters.Font.Color = vbWhite
                    .Name = SHAPENAME
                    .BackgroundStyle = msoBackgroundStylePreset7
                End With
        End Select
    End If
End Sub

I wonder what else it can do...