Adding to code for pop-ups

[ChristineJ]

This code below from my worksheet creates a pop-up box when certain cells in columns Q, S, and U have a value and are selected. The contents of the pop-up include the text values in other cells in the same row. (Blue text below.)

I'd like to ADD similar functionality for creating the pop-ups in certain cells in columns BI, BK, BM, and BO. However, rather than pulling the text values in the pop-ups from cells in the same row, I would like any cell in a column to have the same contents in the pop-up.

For example, when any cell in the range in BI is clicked on, its pop-up would have:
This is test 1.
This is test 2.
This is test 3.
ANSWER: 55

When any cell in the range in BK is selected, the pop-up would have:
This is test 4.
This is test 5.
This is test 6.
ANSWER: 77

Same for the other two columns. The text sentences would vary quite a bit more than my example above.
Can this code be modified? Thanks.

    Dim strTitle As String
    Dim strMsg As String
    Dim lDVType As Long
    Dim sTemp As Shape
    On Error Resume Next
    Set sTemp = ActiveSheet.Shapes("txtInputMsg")
    '*
    'Code will only work if A13=1 (pop-ups) A34=1 so pop-up does not appear before grading occurs (next line)
    If Range("B6").Value <> 1 Then Exit Sub
    If Range("A34").Value <> 1 Then Exit Sub
    
    '* Add the box if does not exist
    If Err.Number <> 0 Then
        Set sTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 72, 72)
        sTemp.Name = "txtInputMsg"
    End If
    '*
    '* Exit if not in range
    
    With Target
        ' test whether there is more than one cell in the selection, that the cell is in
        ' column 'Q', 'S', or 'U' (Each of these is a named range), that there is something in the cell
        ' and that it has a validation rule applied.
        lDVType = 99
        lDVType = Target.Validation.Type
        If 1 < .Cells.Count Or _
                Application.Intersect(.Cells, Union(Range("ColumnQ"), Range("ColumnS"), Range("ColumnU"))) Is Nothing Or _
                .Value = "" Or lDVType = 99 Then
        
            sTemp.TextFrame.Characters.Text = ""
            sTemp.Visible = msoFalse
        Else
            Application.EnableEvents = False
            .Validation.ShowInput = False
            Select Case .Column
                'Each of these is the column number
                Case 17    '* Column Q
                    strTitle = IIf(CStr(Range("AO" & .Row)) = "", "", (CStr(Range("AO" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AP" & .Row)) = "", "", (CStr(Range("AP" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AQ" & .Row)) = "", "", (CStr(Range("AQ" & .Row)) & vbCr))
                    strMsg = IIf(CStr(Range("AG" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                        CStr(Range("AG" & .Row)))
                Case 19    '* Column S
                    strTitle = IIf(CStr(Range("AR" & .Row)) = "", "", (CStr(Range("AR" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AS" & .Row)) = "", "", (CStr(Range("AS" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AT" & .Row)) = "", "", (CStr(Range("AT" & .Row)) & vbCr))
                    strMsg = IIf(CStr(Range("AI" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                        CStr(Format(Range("AI" & .Row), "#,###")))
    
                Case 21    '* Column U
                    strTitle = IIf(CStr(Range("AU" & .Row)) = "", "", (CStr(Range("AU" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AV" & .Row)) = "", "", (CStr(Range("AV" & .Row)) & vbCr)) & _
                        IIf(CStr(Range("AW" & .Row)) = "", "", (CStr(Range("AW" & .Row)) & vbCr))
                    strMsg = IIf(CStr(Range("AK" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                    CStr(Format(Range("AK" & .Row), "#,###")))
    
            End Select
            strMsg = IIf(Range("B1") = 3, "", strMsg)
            strTitle = IIf(Range("B1") = 2, "", strTitle)
            '*
            '* Remove last vbCR from strTitle if strMsg = ""
            strTitle = IIf(strMsg = "", LEFT(strTitle, Len(strTitle) - 1), strTitle)
            sTemp.TextFrame.Characters.Text = strTitle & strMsg
            sTemp.TextFrame.AutoSize = True
            sTemp.TextFrame.Characters.Font.Bold = False
            sTemp.TextFrame.Characters(1, Len(strTitle)).Font.Bold = False
            sTemp.LEFT = .Offset(0, -5).LEFT
            sTemp.Top = .Top - sTemp.Height
            sTemp.Visible = msoTrue
        
            On Error GoTo 0
            Application.EnableEvents = True
        End If
    End With

 

[sijpie]

Ah, I suddenly realise. I had this issue as well when writing & testing the code.
Because your code hang the first time, what happened was that Excel had read the instruction:

Application.EnableEvents=False

Now it remembers that . So unitl you set it bac to true, or quit Excel and start again, the events are off. So it won't show the box.

While you are testing, have a short sub in your code, such as:

sub EnEv()
application.enableevents=true
end sub

If the code hung for some reason, first run this snppet, and you are on your way.

 

[ChristineJ]

I first tried putting your snippet code in a module and running it as a macro, but that didn't do it.

I then tried putting application.enableevents=true right in the code, as follows:

        Else
            Application.EnableEvents = False
            .Validation.ShowInput = False

Application.EnableEvents = True

            Select Case .Column

which is probably not what you meant. Still can't get it going yet. CJ

 

[sijpie]

Well it works for me. I have a test sheet here:
https://www.dropbox.com/s/y0cfvcoyv5by9i6/popup label.xlsm

What you can do is go into the code, and then to the left of the 'If Application. etc line, click in the border. The line should turn red.
Now go to your sheet, and go to a cell wher it should (or shouldn't) work. The macroeditor will come forward, with a little yellow arrow sitting on the red line. It hs stopped here and hasn't exxecuted this line yet. Now by pressing F8 key, you can continue the macro one line at a time. So now you can see if it thinks it sould show up a box or not, and where things go wrong.

 

[ChristineJ]

I can see that your demo spreadsheet is working perfectly. Same code as mine. I am going to start a new demo spreadsheet of my own and try again.

Based on your instructions, seems to be hanging up here:

                .Value = "" Or lDVType = 99 Then
            If Not sTemp Is Nothing Then    'if txtbox does exist
                sTemp.TextFrame.Characters.Text = ""
                sTemp.Visible = msoFalse
            End If
            Exit Sub

Thanks for staying with me on this. I'll start a new spreadsheet with your code. Appreciate your time! CJ

 

[ChristineJ]

If I remove "Or lDVType = 99" in my spreadsheet from the code I posted in my previous post, it works fine. What does "Or lDVType = 99" mean? Will there be a problem if I don't include that?

 

[ChristineJ]

Got it!!! The issue was that I had my validation under the Input Message tab (which worked with my original, not-so-organized code). You had it an numerical values under the Settings tab. Once I saw that in the spreadsheet you provided, I changed mine and finally, IT WORKED!

I can't thank you enough for all the help you have given me on this! Chris

 

[sijpie]

If I remove "Or lDVType = 99" in my spreadsheet from the code I posted in my previous post, it works fine. What does "Or lDVType = 99" mean? Will there be a problem if I don't include that?

You have this in your code:

        lDVType = 99
    On Error Resume Next
        If Target.Validation.Type Then lDVType = Target.Validation.Type
    On Error GoTo 0

So a variable IDVType is set to 99.
Next the validation type of the cell is checked. If there is no data validation then IDVType will be unchanged, else it gets a number for the type of validation.

Then later in the 'if application. etc ' part, it is checked what the value of IDVType is. If it is 99 then no validation is in place for the cell, and so it exits the sub.

 

[Christina594]

You were right; one of my range names was incorrect.

 

[ChristineJ]

I appreciate the explanation. It is all working now. You have really helped me out. CJ

 

[ChristineJ]

One more question - this occurs in the spreadsheet you sent me as well.

The way to cause the pop-up to disappear is to click on a cell that is not in one of the named ranges affected by the code.

However, many of those cells are merged in my spreadsheet. When I click on a merged cell, the pop-up does not disappear (it did in my original code), and it would be better if it did.