Floating Command Button on Excel Sheet within the Active Window

[arijitirf]

Hello!!
I need a Floating Command Button on the Excel Worksheet which can automatically moves around within the area of Active Window (if the Command Button is positioned on the Top Right Corner and as soon as I move the Cursor to the active cell in the Top Right corner then the Command Button should move to its Left and the Command Button would not leave the Active Window Area.)

I'm using below Codes to get the position of the Command Button in the Top Right Corner but issue with this code is it blocks view of the Cell on the Top Right Corner.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
With Me.CommandButton1
.Top = ActiveWindow.VisibleRange.Top 'ActiveCell.Top + ActiveWindow.VisibleRange '+ .Width
.Left = ActiveWindow.VisibleRange.Width - 93
End With
End Sub

I want it to be moved automatically to its left when the cursor position is on the top Right Cell, just beneath the Command Button.

Requesting help

Thanks in advance.

 

[jkpieterse]

So the button should move with the activecell position?

 

[jkpieterse]

Something like this maybe?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Me.CommandButton1
        .Left = ActiveCell.Left - .Width
        .Top = ActiveCell.Top
    End With
End Sub

 

[arijitirf]

Something like this maybe?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With Me.CommandButton1
        .Left = ActiveCell.Left - .Width
        .Top = ActiveCell.Top
    End With
End Sub

Actually, I want a code by which, Command Button will stick to the Top Right Corner but if I need to see the cell where the Command Button is positioned, then the Command Button will move to its left. It will not leave the Active Window area.

 

[jkpieterse]

This appears to work:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim topRightCell As Range
    Dim vr As Range
    Set vr = ActiveWindow.VisibleRange
    Set topRightCell = ActiveSheet.Cells(vr.Cells(1, 1).Row, vr.Columns.Count + vr.Cells(1, 1).Column - 3)
    With Me.CommandButton1
        .Left = topRightCell.Left
        .Top = topRightCell.Top
        If ActiveCell.Left >= .Left Then
            If ActiveCell.Top <= (.Top + .Height) Then
                .Left = .Left - .Width
            End If
        End If
    End With
End Sub

 

[arijitirf]

Dear Pieterse,

Thanks you so much for helping me with the fantastic code. It works absolutely as per my requirement.

Regards,

Arijit Ghosh

 

[arijitirf]

Dear Pieterse,

One little help is required. Code is working fine but only problem is its position is not on the extreme top right corner. Position of the Command Button is on the top but little shifted towards left.

Can this be fixed. If not then kindly help with your code so that the button could be placed on the Extreme Bottom Left position.

Thanks & Regards,

Arijit Ghosh

 

[jkpieterse]

The problem is that the extreme right position of the screen does not nicely line up with a cell border. No time to adapt to bottom-left, perhaps someone else here has?

 

[arijitirf]

The problem is that the extreme right position of the screen does not nicely line up with a cell border. No time to adapt to bottom-left, perhaps someone else here has?

Yes Cell Border is creating the issue in it. Anyway Thank you for your time.

Regards,

Arijit Ghosh

 

[jkpieterse]

For bottom-left, the code changes to this:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim bottomLeftCell As Range
    Dim vr As Range
    Set vr = ActiveWindow.VisibleRange
    Set bottomLeftCell = ActiveSheet.Cells(vr.Rows.Count + vr.Cells(1, 1).Row - 3, vr.Cells(1, 1).Column)
    With Me.CommandButton1
        .Left = bottomLeftCell.Left
        .Top = bottomLeftCell.Top
        If ActiveCell.Left >= .Left Then
            If ActiveCell.Top >= (.Top - .Height) Then
                .Left = .Left + .Width
            End If
        End If
    End With
End Sub