VBA Runtime Error when Selecting Dropdown List

Tigron

New Member
Joined
Jun 2, 2023
Messages
21
Office Version
  1. 2021
Platform
  1. MacOS
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:
VBA Code:
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!
 

Attachments

  • Debug_Error.png
    Debug_Error.png
    51.8 KB · Views: 18
  • 2023-06-04_22-27-17.jpg
    2023-06-04_22-27-17.jpg
    254.7 KB · Views: 20
I tried creating a new spreadsheet with dropdowns and a longer text to see if I can replicate the results. Unfortunately the results were the same. 😔 Same error code and same place in the code itself.
I really wonder what the problem is.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
It's giving you an out of bounds error. So, when you get the error, you can debug. Try that, and while you are debugging, hover over ws.Shapes.Count to find out how many shapes there are on the sheet (it says two on the copy I have). You can use the immediate window to test. So, if it says that Shapes.Count = 2, you should be able to go into the immediate window and type in

VBA Code:
?ws.Shapes(1).Name

And you should get the name of the shape. Go through one by one and try

?ws.Shapes(1).Name
?ws.Shapes(2).Name
?ws.Shapes(3).Name

until you get the error. Then it should just be a matter of adjusting the for loop so that it stays within bounds of the shapes' index.
 
Upvote 1
Also, I guess we could skirt the index issue using a for each loop.

Try this.

VBA Code:
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

Set ws = ActiveSheet

'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

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
                .Name = SHAPENAME
                .BackgroundStyle = msoBackgroundStylePreset10
            End With
    End Select
End If
End Sub
 
Upvote 1
Solution
From which code version should I start? Your first reply plus this snippit?
VBA Code:
For icount = ws.Shapes.Count -1 To 0 Step -1

Btw I get a compile error on your last suggestion.

I will have to get back to you tomorrow. It's almost 11p.m. here in Germany. Have a great evening!
 
Upvote 0
Ok, good night.

When you start up again tomorrow, I think you're getting the compile error because you have 'Option Explicit' at the top of your code.

Try adding

VBA Code:
Dim shx as Shape

where you are dimensioning your other variables.
 
Upvote 1
YES!!! 🤩🥳 It works!! Thank you, danke, muchas gracias, merci beaucoup!

And what's equally cool: the popup only appears if the cell actually contains text. That's perfect!

If I wanted to change the background color to black, the font color to white and font size to 12, would I have to do it here?
VBA Code:
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
                .Name = SHAPENAME
                .BackgroundStyle = msoBackgroundStylePreset10
            End With
 
Last edited:
Upvote 0
Awesome! Eindrucksvoll!

Im stoked that it worked.

Go through the presets, i.e. msoBackgroundStylePreset1
msoBackgroundStylePreset2

One of those has a nice black background.

I won't be near my computer for a while, but to change the text color it will be something like

.TextFrame2.Characters.Font.Color = vbwhite
 
Upvote 1
Yes I saw that option and am playing around with it right now. :)
I'll try to implement vbwhite. Awesome! Thank you 🤙

Edit:
I get an error because of .TextFrame2.Characters.Font.Color = vbwhite
If I understand the debug message correctly, its because of this code:
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)


It's not important to reply any time soon. Whenever you have time. I just wanted to give you a quick feedback.
 
Last edited:
Upvote 0
Ah, it was TextFrame, not TextFrame2.

This is working on my end.

VBA Code:
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.Color = vbWhite
                .Name = SHAPENAME
                .BackgroundStyle = msoBackgroundStylePreset12
            End With
    End Select
End If
End Sub
 
Upvote 1
Yes, this works :) Thank you!
I'm going to see how far I can get on my own to change font size and border color. Perhaps I can come back to you, if I don't succeed??
 
Upvote 0

Forum statistics

Threads
1,223,162
Messages
6,170,431
Members
452,326
Latest member
johnshaji

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top