Can Excel unhide/hide rows just by hovering a mouse over it

[atuljadhavnetafim]

Hi,

I have values in D4 Cell which is sum of D5:D8 and again I have value in D9 cell which is sum of D10:D13 and so on......
now I don't want to use Group/Ungroup function because there are so many items in my excel and not practice to group/ungroup each time.
so what I want, whenever I hovering mouse to D4, excel slowly unhide Row 5 to 8 and once I remove mouse from D4 excel slowly hide those row.

I know this is possible in excel but just know howwwwww.

Thanks in advance

 

[mark hansen]

That did the trick dataluver.

Personally I like the first method using the timers while on the dashboard worksheet. They turn off when leaving the dashboard worksheet. Maybe that's because I seems to understand the code easier.

Rory, you started the direction away from the timers, is there anything bad about using the timer to perform this function?

I love the concept either way, Atul, thanks for the question that started the whole thing. This board has the neatest ideas to improve what Excel can do by bring up ideas and solutions to improve yourself and your Excel workbooks.

("board", I'm showing my age... Back in the day, forums were called bulletin boards)
Mark

 

[RoryA]

No I was just saying that what you had described didn’t need timers anyway, and then suggesting that the UDF/HYPERLINK trick might be a good way of starting the timer so it’s not running longer than it needs to.

 

[Jaafar Tribak]

Safer than using a windows timer (which is prone to crashing the entire excel application if an unhandled error occurs) , one could use the commandbars OnUpdate event as a more stable alternative.

 

[Legacy 456155]

How do you trap hovering over a cell using that event?

 

[Jaafar Tribak]

How do you trap hovering over a cell using that event?

This is how I would do it ... IMHO, this approach, although slightly slower than using a high res Windows timer it is much safer (you don't have to worry about crashing the application should an unhandled error occur or the the VBE STOP button is pushed)

Another safer approach that you could use is by continiously calling the PeekMessage API inside a loop and monitor the WM_SETCURSOR message but this approach too would put too much strain on resources.

Probably, the "best" way is using CommandBras OnUpdate as follows:

Workbook Sample

Code goes in the ThisWorkbook Module:

Option Explicit

Private WithEvents Cmndbars As CommandBars

Private Type POINTAPI
    x As Long
    Y As Long
End Type

#If VBA7 Then
    Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#Else
    Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
#End If



Private Sub Workbook_Activate()

    [a1] = "":   [a2] = "":   [a3] = ""
     EnableCellMouseEvents = True

End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    [a1] = "":   [a2] = "":   [a3] = ""
    EnableCellMouseEvents = False

End Sub


Private Property Let EnableCellMouseEvents(ByVal Enable As Boolean)

    If Enable Then
        Set Cmndbars = Application.CommandBars
        Call Cmndbars_OnUpdate
    Else
        Set Cmndbars = Nothing
    End If

End Property


Private Sub Cmndbars_OnUpdate()
    Static lPrevKeyState As Long
    Static oPrevCell As Range
    Dim oCurCell As Variant
    Dim tCurPos As POINTAPI


    If GetActiveWindow <> Application.hwnd Then Exit Sub

    GetCursorPos tCurPos
    Set oCurCell = ActiveWindow.RangeFromPoint(tCurPos.x, tCurPos.Y)

    If TypeName(oCurCell) = "Range" Then
        If GetKeyState(VBA.vbKeyLButton) <> lPrevKeyState Then
           Call OnCellMouseClick(oCurCell)
         End If
        If Not oPrevCell Is Nothing Then
            If oPrevCell.Address <> oCurCell.Address Then
                Call OnCellMouseLeave(oPrevCell)
                Call OnCellMouseEnter(oCurCell)
            End If
        Else
            Call OnCellMouseEnter(oCurCell)
        End If
    End If

    Set oPrevCell = oCurCell
    lPrevKeyState = GetKeyState(VBA.vbKeyLButton)
    With Application.CommandBars.FindControl(ID:=2020): .Enabled = Not .Enabled: End With


End Sub


Private Sub OnCellMouseEnter(ByVal Target As Range)

    [a1] = "Enter " & Target.Address
    Select Case Target.Address(0, 0)
        Case "B5"
            Rows("6:8").EntireRow.Hidden = False
        Case "D10"
            Rows("11:13").EntireRow.Hidden = False
        Case "F15"
            Rows("16:18").EntireRow.Hidden = False
    End Select

End Sub


Private Sub OnCellMouseLeave(ByVal Target As Range)

    [a2] = "Leave " & Target.Address
    Select Case Target.Address(0, 0)
        Case "B5"
            Rows("6:8").EntireRow.Hidden = True
        Case "D10"
            Rows("11:13").EntireRow.Hidden = True
        Case "F15"
            Rows("16:18").EntireRow.Hidden = True
    End Select

End Sub


Private Sub OnCellMouseClick(ByVal Target As Range)

     [a3] = "You Clicked on cell:  " & Target.Address
    MsgBox "You Clicked on cell:  " & Target.Address

End Sub

EDIT:
The code also adds a handy Cell-Click pseudo event which excel doesn't provide by default.

 

[Legacy 456155]

Very clever Jafaar and the code is simpler. This seems like a good solution for the dashboard hide/unhide effect. It's a bit too slow for shapes, I think. Maybe you might adapt it to work with shapes if you think it's worth a shot? As for using timers, I've been using them for years without any problems though a few precautions are necessary.

Example download using Jafaar's method: see file --> "Range from point Jafaar.xlsm"

Mark, here is an example that works with shapes. We'll see if Jafaar responds with a variation of the commandbars method.
Example download: see file --> "RangeFromPoint 2 w shapes.xlsm"

Jafaar? Any way to change the cursor when the user hovers over a shape?

In workbook:

Option Explicit

Dim d As New Dictionary

Public Sub Workbook_Open()
    d.Add "B5", 0
    d.Add "D10", 0
    d.Add "F15", 0
    d.Add "MyHappyRollover", 0
    
    Workbook_SheetActivate ActiveSheet
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    StopTicking
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If TypeOf Sh Is Worksheet Then If Sh.codeName = "Sheet1" Then StartTicking d, 10
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If TypeOf Sh Is Worksheet Then If Sh.codeName = "Sheet1" Then StopTicking
End Sub

In module:

Option Explicit

Private Enum EnumItemType
    None
    Range
    Shape
End Enum

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hwnd As LongPtr, ByVal nIDEvent As Long) As Long
Private Declare PtrSafe Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long

Private targets As Dictionary

Public Sub StopTicking()
    KillTimer Application.hwnd, 1
End Sub

Sub StartTicking(targets As Dictionary, pollingInterval As Long)
    Set Module1.targets = targets
    SetTimer Application.hwnd, 1, pollingInterval, AddressOf TickTock
End Sub

Public Sub TickTock(ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long)
    On Error Resume Next
    Static previousRange As Range
    Static previousShape As Shape
    Static previousTarget As EnumItemType
    Dim currentTarget As Variant
    Dim currentRange As Range
    Dim currentShape As Shape
    Dim pt As POINTAPI
    Dim lNum As Integer
    
    GetCursorPos pt
    Set currentTarget = ActiveWindow.RangeFromPoint(pt.x, pt.y)
    If currentTarget Is Nothing Then
        If previousTarget = EnumItemType.Range Then
            Call ActiveSheet.CellLeave(previousRange)
        ElseIf previousTarget = EnumItemType.Shape Then
            Call ActiveSheet.ShapeLeave(previousShape)
        End If
        previousTarget = None
    Else
        If TypeOf currentTarget Is Range Then
            Set currentRange = currentTarget
            If previousTarget = EnumItemType.Range Then
                If currentTarget.Address <> previousRange.Address Then
                    Call ActiveSheet.CellLeave(previousRange)
                    If targets.Exists(currentTarget.Address(0, 0)) Then
                        Call ActiveSheet.CellEnter(currentRange)
                        Set previousRange = currentRange
                        previousTarget = EnumItemType.Range
                    Else
                        previousTarget = EnumItemType.None
                    End If
                End If
            ElseIf previousTarget = EnumItemType.Shape Then
                Call ActiveSheet.ShapeLeave(previousShape)
                If targets.Exists(currentTarget.Address(0, 0)) Then
                    Call ActiveSheet.CellEnter(currentRange)
                    Set previousRange = currentTarget
                    previousTarget = EnumItemType.Range
                Else
                    previousTarget = EnumItemType.None
                End If
            Else
                    If targets.Exists(currentTarget.Address(0, 0)) Then
                        Call ActiveSheet.CellEnter(currentRange)
                        Set previousRange = currentRange
                        previousTarget = EnumItemType.Range
                    Else
                        previousTarget = EnumItemType.None
                    End If
            End If
        Else
            If previousTarget = EnumItemType.Range Then
                Call ActiveSheet.CellLeave(previousRange)
            ElseIf previousTarget = EnumItemType.Shape Then
                If previousShape.Name <> currentTarget.Name Then Call ActiveSheet.LeaveShape(previousShape)
            End If
            currentTarget = currentTarget.Name
            If targets.Exists(currentTarget) Then
                Set currentShape = ActiveSheet.Shapes(currentTarget)
                If previousTarget = EnumItemType.Shape Then
                    If currentShape.Name <> previousShape.Name Then
                        ActiveSheet.ShapeEnter currentShape
                        Set previousShape = currentShape
                        previousTarget = EnumItemType.Shape
                    End If
                Else
                    ActiveSheet.ShapeEnter currentShape
                    Set previousShape = currentShape
                    previousTarget = EnumItemType.Shape
                End If
            Else
                previousTarget = EnumItemType.None
            End If
        End If
    End If
End Sub

Stubs in worksheet(s):

Public Sub CellEnter(target As Range)

End Sub

Public Sub CellLeave(target As Range)

End Sub

Public Sub ShapeEnter(target As Shape)

End Sub

Public Sub ShapeLeave(target As Shape)

End Sub

 

[mark hansen]

Dataluver, they for the file with the shapes... I go the joke. this looks like something I can work with when the time comes. All of these files with code are saved in my New ideas folder. I pull them when someone asked if something can happen.

 

[atuljadhavnetafim]

Thank you, experts,

I got it what I want,

 

[Jaafar Tribak]

Mark, here is an example that works with shapes. We'll see if Jafaar responds with a variation of the commandbars method.

Jafaar? Any way to change the cursor when the user hovers over a shape?

Hi dataluver,

I guess one can still use the commandbars OnUpdate event to monitor mouse moves over shapes ... I gave this a quick shot and looks promising.

As for changing the cursor when the user hovers over a shape, that is going to be more difficult because shapes are windowless controls so you can't subclass them and trap the WM_SETCURSOR message nor can you temporarly change their class style with GCL_HCURSOR.

I am writing some alternative code and if it works, I'll post here later.

Regards.

 

[Legacy 456155]

Look forward to seeing your solution.