Hover Over / VS selecting the cell

Drrellik

Well-known Member
Joined
Apr 29, 2013
Messages
834
Office Version
  1. 365
  2. 2016
  3. 2013
  4. 2011
  5. 2010
Platform
  1. Windows
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:

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
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
 
Upvote 0
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:
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

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