Keep Listbox at top of Scrolling Worksheet [duplicate] - excel

Question

I have an excel workbook with two shapes on Sheet1 like below
My Requirement is when the user is navigating towards right side of sheet i.e. Towards headers24, header25 and so on ,I want the two shapes on the sheet to move towards the right side with the user.
Can someone Please suggests any ideas for this.
Thanks

Answer 1

Try this.. yep, its easy..
Place this code in the worksheet module where the shapes exist.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ActiveSheet.Shapes(1)
.Left = ActiveWindow.VisibleRange(2, 2).Left
.Top = ActiveWindow.VisibleRange(2, 2).Top
End With
End Sub
The coordinate (2, 2) is where you want the shape to be fixed at as you scroll along with the keyboard.
But, it would be annoying to work without the scroll bar on a huge worksheet. so alternatively I think you can use refresh ontime, place this code in a Module
Private eTime
Sub ScreenRefresh()
With ThisWorkbook.Worksheets("Sheet1").Shapes(1)
.Left = ThisWorkbook.Windows(1).VisibleRange(2, 2).Left
.Top = ThisWorkbook.Windows(1).VisibleRange(2, 2).Top
End With
End Sub
Sub StartTimedRefresh()
Call ScreenRefresh
eTime = Now + TimeValue("00:00:01")
Application.OnTime eTime, "StartTimedRefresh"
End Sub
Sub StopTimer()
Application.OnTime eTime, "StartTimedRefresh", , False
End Sub
And the following code in Sheet1 (where the shapes are in)
Private Sub Worksheet_Activate()
Call StartTimedRefresh
End Sub
Private Sub Worksheet_Deactivate()
Call StopTimer
End Sub

Answer 2

First create the shape:
Sub Creator()
Dim shp As Shape
Set shp = ActiveSheet.Shapes.AddShape(1, 100, 10, 60, 60)
shp.TextFrame.Characters.Text = "I will follow"
shp.Name = "MyButton"
End Sub
Then in the worksheet code area:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim sh As Shape, r As Range
Set sh = ActiveSheet.Shapes("MyButton")
Set r = ActiveCell
sh.Top = r.Offset(-1, -2).Top
sh.Left = r.Offset(-1, -2).Left
End Sub
If you move the active cell back and forth, the box will move with it.
Note:
This is only demo code. You still need to:
add protection to prevent trying to move the Shape "off-screen"
setting the proper offsets from ActiveCell based on the size of the Shape