Calendar tooltip

[samc2696]

Hi all,


I have a month-by-month calendar in an excel spreadsheet, that currently fills the cell with the event title (based of a table of event data).


What I really want to achieve is that when the user clicks on the cell, a window/textbox will appear with more details of that event in. I would really like to be able to format this text box in a style that matches the calendar too.


Unfortunately the work is confidential, but I should be able to work with the code, I just do not know how to start it.


Many thanks
Sam

 

[Yongle]

one way...

Insert an Active-X textbox on the worksheet with AutoSize, EnterKeyBehaviour, MultiLine and WordWrap set to TRUE
Cancel Design mode

Paste code below to sheet module (right-click sheet tab \ View Code \ Paste to window \ amend range of cells triggered \ {ALT}{F11} to go back to Excel)

Private Sub TextBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    TextBox1.Visible = False
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
        
    If Not Intersect(Target, Range("[COLOR=#ff0000]A1:Z999[/COLOR]")) Is Nothing Then
        With TextBox1
            .Value = Target.Value & vbCr & [COLOR=#ff0000]DetailsFromCalendar[/COLOR]
            .Left = Target.Left + Target.Width + 5
            .Top = Target.Top
            .Visible = True
        End With
    End If
End Sub

To test, click on any cell in the specified range and the textbox should move there containing the correct text
Mouse-over the textbox to make it invisible
After testing, format the textbox as you see fit

 

[Logit]

.
Some of the code :

Private Sub CancelButton_Click()


Unload UserForm1
End Sub


Private Sub DeleteButton_Click()


    Application.ScreenUpdating = False
    
    Sheets("Data").Select


    Range("B2").Select
    
    Do While ActiveCell.Value <> Empty
    
        If ActiveCell.Value = Sheets("Data").Range("J1") Then
    
            ActiveCell.Offset(0, 1).Select
        
            If ActiveCell.Value = Sheets("Data").Range("J2") Then
        
                ActiveCell.Offset(0, 1).Select
            
                ActiveCell.Value = ""
            
                ActiveCell.Offset(0, 1).Select
            
                ActiveCell.Value = ""
                
                ActiveCell.Offset(0, -2).Select
            
            End If
        
            ActiveCell.Offset(0, -1).Select
        
        End If
    
    ActiveCell.Offset(1, 0).Select
    
    Loop
    
    Sheets("Calendar").Select
    
    Unload UserForm1


End Sub


Private Sub SaveButton_Click()


    Dim Checkval As Boolean
    
    Checkval = False


    Application.ScreenUpdating = False


    Sheets("Data").Select


    Range("B2").Select
        
    Do While ActiveCell.Value <> Empty


        If ActiveCell.Value = Sheets("Data").Range("J1") Then
    
            ActiveCell.Offset(0, 1).Select
        
            If ActiveCell.Value = Sheets("Data").Range("J2") Then
        
                ActiveCell.Offset(0, 1).Select
            
                ActiveCell.Value = Me.TextBox2.Value
            
                ActiveCell.Offset(0, 1).Select
            
                ActiveCell.Value = Me.TextBox3.Value
                
                Checkval = True
                
                ActiveCell.Offset(0, -2).Select
            
            End If
        
            ActiveCell.Offset(0, -1).Select
        
        End If
        
        ActiveCell.Offset(1, 0).Select
    
    Loop
    
    If Checkval = False Then


        ActiveCell.Value = Sheets("Data").Range("J1")
    
        ActiveCell.Offset(0, 1).Select


        ActiveCell.Value = Sheets("Data").Range("J2")
    
        ActiveCell.Offset(0, 1).Select


        ActiveCell.Value = Me.TextBox2.Value
    
        ActiveCell.Offset(0, 1).Select


        ActiveCell.Value = Me.TextBox3.Value
        
    End If






Sheets("Calendar").Select


Unload UserForm1


End Sub


Private Sub TextBox2_Change()


End Sub


Private Sub Label1_Click()


End Sub


Private Sub UserForm_Initialize()


    Me.TextBox3.Value = Sheets("Data").Range("J4").Value
    
    Me.TextBox2.Value = Sheets("Data").Range("J3").Value
    
    
End Sub

Download workbook : https://www.amazon.com/clouddrive/share/g972JxXJz7h3f1U8bHrivBX76WugNnX8blmvKSAHBeB

 

[samc2696]

Hi Yongle,

Functionally speaking it does what I want it to do - however, one thing I would like is for the information in the Textbox to be the other event information which is where the event title is pulled from. How would I go about doing that?

Thank you!
Sam

 

[samc2696]

Hi Logit,

I dont think i explained myself correctly, but thank you for taking the time do that. Unfortunately its not exactly what i need!

Sam

 

[Yongle]

I would like is for the information in the Textbox to be the other event information which is where the event title is pulled from. How would I go about doing that?

Q Where will VBA find the "other information" relating to an event?

example
- event title is "Big Secret Meeting"
- value in cell C10 is "Big Secret Meeting"
- WHERE (in Excel) is the "other information" relating to "Big Secret Meeting"
- is it possible to lookup "Big Secret Meeting" in an existing data table to return "other information"?

 

[samc2696]

I just realised you had highlighted in red the "details from calendar" part. So I am assuming this is where I would put the reference to the detail. The only issue is I do not know how to reference this. In the table of events if the event title is in col. A with the title of "Event title" then, for example, one of the pieces of other information I would like is in col.B "Event Category. Once I can do one I am sure I can do the others.

Just seen your post so edit:

All the data is in a table called DE_Events (on another sheet called "Event Data", and so I assume it is possible to look it up

Thank you
Sam

 

[samc2696]

Also, it will not let me change the range to my named range - I keep getting a "run time error 1004: method 'range' of object_worksheet; failed

I have modified the code as such:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)        
    If Target.CountLarge > 1 Then Exit Sub
        
    If Not Intersect(Target, Range("month_data")) Is Nothing Then
        With TextBox1
            .Value = Target.Value & vbCr & DetailsFromCalendar
            .Left = Target.Left + Target.Width + 5
            .Top = Target.Top
            .Visible = True
        End With
    End If
End Sub

the named range is all the cells that the event title will go in i.e. so only when the use clicks on them the macro will work

Thanks
Sam

 

[Yongle]

Dealing with your last query first...

I created a named range month_data and tested (see code below)
- it works
- is your Name correct?
- does the Name exist?
- is it a workbook level name?
- what is its RefersTo formula?
- is the sheet name in the RefersTo formula consistent with the name of the tab containing the VBA?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("month_data")) Is Nothing Then
        MsgBox "YES"
    Else
        MsgBox ("No")
    End If
End Sub

 

[samc2696]

Ah I realised my named ranges weren't actually referring to properly, all sorted now thank you!