code to highlight Excel row upon hover

Topic

New Reply

Is VisualBasic able to code for highlighting a row when mouse cursor is hovering over that row?

Reply | Quote

Replies

Calvin,

I can’t find an event to accomplish that in either the Workbook or Sheet models. HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

RG,

I am sure you can do something with the code here to make it work

http://windowssecrets.com/forums/showthread//165438-Instructions-for-textboxes

Maud

Reply | Quote

Maud,

Nice piece of code but unfortunately the Mouse events are Methods of the Textbox class short of putting a textbox at the top of each column I don’t see how to use it to accomplish the OP’s task. Am I missing something? :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

“With a little help from my friends” Beatles, Sgt. Pepper’s Lonely Hearts Club Band, June, 1967

As RG pointed out, a mouseover for a textbox has no practical application in Calvin’s needs. I initially was working with a hyperlink formula to point to the macro but that would mean that every cell in the range would need to have the formula inserted making that an impractical approach as well. So I turned to x-y coordinates and am almost there.

I need some input from you (all members) to get around an obstacle I am running into to highlight the rows when hovered over. The following code will highlight the rows moving the mouse over the cells for about 5 seconds but then stops highlighting even though the code is still running in the background. To end the code, just move the cursor outside the range of data.

If someone can come up with a workaround to get pass the 5 second time limit, they will get a well deserved press on their “Thanks” button from me (best I can offer).

Maud

40374-testrollover

This code was adapted from Any Pope’s code to find the xy coordinates over at Ozgrid

Code:

Declare Function GetCursorPos Lib “user32” (lpPoint As POINTAPI) As Long
Type POINTAPI
    x As Long
    y As Long
End Type
 
Sub CurosrXY_Pixels()
    Dim lngStatus As Long
    Dim typWhere As POINTAPI
    Dim rng As Range
    Set rng = Range(“A1:E19”)
    Range(“H3”) = 0
    Range(“I3”) = 0
    Do While Range(“H3”) <= 357 And Range("I3") <= 566
        lngStatus = GetCursorPos(typWhere)
        Range("H3") = typWhere.x
        Range("I3") = typWhere.y
        Row = Int(Range("I3") / 20) – 8
        Range("G3") = Row
        rng.Interior.Color = vbWhite
        Range("A" & Row & ":E" & Row).Interior.Color = vbRed
    Loop
End Sub

Reply | Quote

Maud,

I can’t seem to get the code to do anything except on occasion flip between rows 3 & 4. It seems to me you’d need a loop to almost continuously monitor the cursor position. :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

RG,

There is a loop in the code. Strange that I can go up and down the entire range and the highlighting of the rows will follow for about 5 seconds. Are you keeping your cursor with in the data range? I am wondering if resolution comes into play here. Try staying closer to column A when sliding the cursor up and down or expanding the pixel ranges in Do While Range(“H3”) <= 357 And Range("I3") <= 566. Or are you timing out less than 5 seconds?

Here is a video of what it looks like, however, the cursor does not get recorded. After about 5 seconds, it stops highlighting and I move the cursor out of range to end the code. The Start button returns to normal state

Reply | Quote

Maud,

The start button reverts to normal immediately on my Desktop Haswell i-7! However, I copied it over to my Laptop an older Allendale i-5 and it works as shown in your video across the whole range of table cells FOR ABOUT 2 MINUTES!.

I did a second test after widening all the table cells and it quit as soon as I moved out of the predefined size but still within the table.

Third test where I just zoomed the screen with the same results as the 2nd test.

Doesn’t look like it will be a reliable method since it is obviously dependent on processor speed, screen resolution, and cell width. HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

RG,

Thanks for the follow-up. I too have a core I7 but first generation oc to 4.2GHz. Maybe not as fast as yours. Using your “beast rig”, could you try doubling the x-y-pixels in the line Do While Range(“H3”) <= 357 And Range("I3") <= 566 while keeping the cell width at 8.43(64 pixels) and the cell height at 15.0(20 pixels). My resolution is at 1960 x 1080. What is yours? Any thoughts on the timeout issue? contemplating a pause function.

Update: adding the pause seemed to cure the time out. but still need to work on resolution issue. RG- I await your test results when you get around to it

Code:

Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Type POINTAPI
    x As Long
    y As Long
End Type
 
Sub CurosrXY_Pixels()
    Dim lngStatus As Long
    Dim typWhere As POINTAPI
    Dim rng As Range
    Set rng = Range("A1:E19")
    Range("H3") = 0
    Range("I3") = 0
    Do While Range("H3") <= 357 And Range("I3") <= 566
        lngStatus = GetCursorPos(typWhere)
        Range("H3") = typWhere.x
        Range("I3") = typWhere.y
        Row = Int(Range("I3") / 20) – 8
        Range("G3") = Row
        rng.Interior.Color = vbWhite
        Range("A" & Row & ":E" & Row).Interior.Color = vbRed
       [COLOR="#0000FF"] Pause[/COLOR]
    Loop
End Sub

Private Sub Pause()
[COLOR="#008000"]'—————————————-
'CHANGE PAUSETIME TO ADJUST SPEED[/COLOR]
Dim PauseTime, Start
    PauseTime = 0.05
    Start = Timer
    Do While Timer < Start + PauseTime
        DoEvents
    Loop
End Sub

Reply | Quote

Maud,

Set up as you instructed…No change!

My screen resolution is 1920X1080. HTH :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG/Maud

..here’s my version.
Turn the row highlighter ON/OFF with a right-mouse-click

zeddy

Reply | Quote

40417-rz-mouse-position-v2 You may like this as well or better. See Attached

Code:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.FormatConditions.Delete
If ActiveSheet.Shapes("Check Box 1").ControlFormat.Value = 1 Then
 With Target.EntireRow
  .FormatConditions.Add Type:=xlExpression, Formula1:="TRUE"
  .FormatConditions(1).Interior.ColorIndex = 35
 End With
End If
End Sub

Reply | Quote

Hi Don

That is nice code for showing rows using the cellpointer, rather than the mouse.

zeddy

Reply | Quote

Zeddy,

Nice job! :thewave:

Also a nice explanation despite the MS “confuse the user” speak!

Would have been even nicer if you’d mentioned the Conditional Formatting! I spent a lot of time trying to figure out where the color was set in the code. :confused: Of course I could have missed it in the MS speak.

Almost forgot it’s easy to modify to do Columns vs Rows.

:cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG

Ooops! I originally described the conditional formatting (range ([A1:R39] )in a text box on the sheet, but I deleted it!
Top marks for tracking that down so quickly!

zeddy

Reply | Quote

Hi RG

..I re-checked my posted file.
Did you see that note in cell [C9]

zeddy

Reply | Quote

Hi RG

..I re-checked my posted file.
Did you see that note in cell [C9]

zeddy

Zeddy,

Nope! Must have been too dazzled by the flashing Yellow lights!
35623-ROTFLOL

Sorry about that! :cheers:

May the Forces of good computing be with you!

RG

PowerShell & VBA Rule!
Computer Specs

Reply | Quote

Hi RG

I was going to make a joke about eyesight but didn’t want to make a spectacle of myself and anyway, my jokes just get cornea and cornea.

zeddy

Reply | Quote

Zeddy,

OUTSTANDING!!!!!

Reply | Quote

20 lashes for that joke!

Reply | Quote

Eye’m getting scleratic with this sight and its jokes. You all have a (optic) nerve and need to become pupils of someone really funny. I’ll have to socket to you…

Sorry, best eye can do…

Eliminate spare time: start programming PowerShell

Reply | Quote

I’m glad you now see it my way.

zeddy

Reply | Quote

Sea it your way? Absolutely, even with a sea between us!

As the chairman of the board said: he did it his way.

Fred

Reply | Quote

I am Blind-sided by some of these PUNs from some of my contacts on this web sight.

Reply | Quote