Hover Over / VS selecting the cell

Drrellik

Well-known Member
Joined
Apr 29, 2013
Messages
738
Hello all,


I have read these two posts about Hover over and wanted to ask if there have been any updates in excel over the years that might allow this to happen now.

https://www.mrexcel.com/forum/excel-questions/515724-show-contents-cell-when-hovering.html
https://www.mrexcel.com/forum/excel-questions/87158-change-color-cell-when-moving-mouse-over.html


I am not after a 12 pack or some bread, but rather curious to see if it can be done now due to updates.

I have a random math problem generator for my kids that uses the random function to create the problems and calculates the correct answer and I have the cell and content value set to white. If the hover over the answer cell and I could get it to change color they could check their answer.

As you know with the Rand() function if you hit enter or oneof several other keys the problems all change.

Not a show stopper, just thought it would be cool

Don
 
Last edited:

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,494
Office Version
2016
Platform
Windows
Here is an easier, a more stable and much better approach that doesn't require the use of a timer,mouse hook or loop and should also work on 32 and 64bit excel:

Workbook example.

For easy use, the code contains a pseudo-event named (OnCellMouseHover)... This pseudo-event takes an argument which holds the current cell under the mouse pointer.


Code in the ThisWorkbook Module:
Code:
Option Explicit

Private WithEvents Cmbrs As CommandBars

Private Type POINTAPI
    x As Long
    y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If


Private Sub Workbook_Activate()
    Set Cmbrs = Application.CommandBars
    Call Cmbrs_OnUpdate
End Sub

Private Sub Workbook_Deactivate()
    Call OnCellMouseHover(Nothing)
    Set Cmbrs = Nothing
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Set Cmbrs = Application.CommandBars
    Call Cmbrs_OnUpdate
End Sub


Private Sub Cmbrs_OnUpdate()

    Static lPrevColor As Long
    Static oPrevCell As Range
    Dim oCurCell  As Range
    Dim tCurPos As POINTAPI
    
    On Error Resume Next
    
    If GetActiveWindow <> Application.Hwnd Then
        Call OnCellMouseHover(Nothing)
        Exit Sub
    End If

    Application.CommandBars.FindControl(ID:=2040).Enabled = Not Application.CommandBars.FindControl(ID:=2040).Enabled

    GetCursorPos tCurPos
    Set oCurCell = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.y)
    
    If oPrevCell.Address <> oCurCell.Address Then
        Set oPrevCell = oCurCell
        Call OnCellMouseHover(oCurCell)
    End If
 
End Sub



[COLOR=#008000][B]'************************************************************
'                   PSEUDO-EVENT
'************************************************************[/B][/COLOR]
Private Sub OnCellMouseHover(ByVal CellUnderMousePointer As Range)

    Static oPrevCell As Range
    Static lPrevColor As Long

    On Error Resume Next

    If CellUnderMousePointer Is Nothing Then
        oPrevCell.Interior.ColorIndex = lPrevColor
    End If
    
    [B][COLOR=#008000]'Apply to Sheet1 only - Remove this line to apply to all sheets.[/COLOR][/B]
    If CellUnderMousePointer.Parent.Name <> "Sheet1" Then Exit Sub

    If oPrevCell.Address <> CellUnderMousePointer.Address Then
        If Not CellUnderMousePointer Is Nothing Then
            oPrevCell.Interior.ColorIndex = lPrevColor
            Set oPrevCell = CellUnderMousePointer
            lPrevColor = CellUnderMousePointer.Interior.ColorIndex
            CellUnderMousePointer.Interior.ColorIndex = 3
        End If
    End If
    
End Sub
 

Drrellik

Well-known Member
Joined
Apr 29, 2013
Messages
738
This works nicely. I can change the cell color from red to what ever I want. I have to make sure it is only in 'This workbook' Thank you again you should enjoy the brew and bread... (y) :p
 
Last edited:

Jaafar Tribak

Well-known Member
Joined
Dec 5, 2002
Messages
7,494
Office Version
2016
Platform
Windows
This works nicely. I can change the cell color from red to what ever I want. I have to make sure it is only in 'This workbook' Thank you again you should enjoy the brew and bread... (y) :p

By default, it works only on the workbook containing the code ... other workbooks are not affected.

Thanks for the feedback.
 

Forum statistics

Threads
1,082,385
Messages
5,365,151
Members
400,825
Latest member
Sreekanth_21

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top