Moving objects by relative position

[seleseped]

Hello,
I have an Excel 2013 worksheet that has several paired Check Boxes and List Boxes on it. When a check box is clicked, its paired list box becomes visible. If it is not checked, its paired list box is not visible. I would like the check box/list box pairs to move up or down on the sheet depending on which other check box/list box pairs have been clicked and are visible above it.

For example . . . here's what the sheet looks like when first opened:
Check box 1 (this check box never moves)
Check box 2
Check box 3
Check box 4

If one clicks check box 1, its list box appears and the other three check boxes move down, so the screen now looks like this:
Check box 1
List box 1
Check box 2
Check box 3
Check box 4

If one de-selects check box 1 and selects check boxes 2 and 3, the screen looks like this:
Check box 1
Check box 2
List box 2
Check box 3
List box 3
Check box 4
. . . where check box 2 has moved back to its original position, list box 2 has become visible, check box 3 has moved down, list box 3 has appeared and check box 4 has moved down.

Now if one de-selects check box 2, the screen looks like this:
Check box 1
Check box 2
Check box 3
List box 3
Check box 4
. . . where list box 2 is no longer visible, check box 3 and list box have moved up, and check box 4 has also moved up.

What I think I need to do is:
1. determine the position of each check box so that the relative position of its paired list box can be incrementally positioned below it and slightly to the right (so that they can move up and down together when the check box(es) above them are checked/unchecked), and
2. determine the relative position of the object above a particular object so that that particular object can be moved in concert with the one above it.

Your help is most greatly appreciated.

 

[igold]

Hi,

I did this for someone who wanted some buttons on his sheet to scroll up and down as he selected different cells. The key to this was that his rows were all 18 (24 pixels) high and his buttons were sized in multiples of 18 as well. This kept the buttons nice and neat and evenly lined up with the rows. It worked out very well.

Perhaps you could adapt this to fit your needs. You really only have to know the name of your shapes to get them to move, and decide what will trigger the code. All he did was to select a certain cell in the row. On all the sheets he used it on he called the sub from the Worksheet Module:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Call MButtons
End Sub

and this code was in a code module. You really only need to adapt the lines in red.

Sub MButtons()
    Dim i As Long
    If ActiveCell.Height <> 18 Then MsgBox "cell hgt is off"""
    If ActiveCell.Column <> 3 Then
        Exit Sub
    End If
    If ActiveCell.Value > 441 Or ActiveCell.Value = "" Then
        Exit Sub
    End If
    i = ActiveCell.Value
[COLOR=#ff0000]    ActiveSheet.Shapes("PartsButton1").Top = (ActiveCell.Row() * 18) - 18[/COLOR]
[COLOR=#ff0000]    ActiveSheet.Shapes("ThesePartsButton1").Top = (ActiveCell.Row() * 18) + 18[/COLOR]
[COLOR=#ff0000]    ActiveSheet.Shapes("LOG_ROUTE_BUTTON").Top = (ActiveCell.Row() * 18) + 54[/COLOR]
[COLOR=#ff0000]    ActiveSheet.Shapes("Rectangle 370").Top = (ActiveCell.Row * 18) + 36[/COLOR]
End Sub

I hope this helps you along some.

igold

 

[seleseped]

THANK YOU very much! I think this will work. I was trying to hide and unhide rows and have the shapes 'float' on top (they were marked 'move but don't size with cells'). It works to some extent but is not stable and I have to be careful about where the shapes are placed. This seems as though it will take away the guess work and will stabilize the buttons' movement. I will try it Monday when I'm back at work. I'm very grateful for your suggestion.

 

[igold]

Please let me know how you make out. If you run into problems perhaps I will be able to lend a hand.

Have a nice weekend.

igold.

 

[igold]

Just so you know... Aside from the Top setting there is also a Left setting. The guy I was helping kept his buttons straight up and down after he manually dragged them to where he wanted, so there was never a need to move them left or right.

 

[seleseped]

Once again I'd like to thank you for your suggestion. My project wound up going in a totally different direction so I wasn't able to use your elegant solution but I've put it in my "bag of Excel tricks" for use in future projects.

 

[igold]

Thank you very much for the thought. The feedback is greatly appreciated.

Regards,

igold

 

[mikerickson]

Or you might try something like this. You'll have to adjust the names to match the convention that you are using. But this will adjust to the actual sizes of the controls.

Dim i as Long
Dim currentTop as Single
Dim gapSize as single
gapSize = 5: Rem adjust to taste

currentTop = ActiveSheet.Shapes("Check Box 1").Top + ActiveSheet.Shapes("Check Box 1").Height + gapSize

For i = 1 to 3
    With ActiveSheet.Shapes("List Box " & i)
        .Top = currentTop
        If .Visible Then currentTop = currentTop + .Height + gapSize
    End With

    With ActiveSheet.Shapes("Check Box " & (i+1))
        .Top = currentTop
        If .Visible Then currentTop = currentTop + .Height + gapSize
    End With
Next i

ActiveSheet.Shapes("List Box 4").Top = currentTop

 

[seleseped]

THANKS. That is a strategy I never would have come up with!

Or you might try something like this. You'll have to adjust the names to match the convention that you are using. But this will adjust to the actual sizes of the controls.

Dim i as Long
Dim currentTop as Single
Dim gapSize as single
gapSize = 5: Rem adjust to taste

currentTop = ActiveSheet.Shapes("Check Box 1").Top + ActiveSheet.Shapes("Check Box 1").Height + gapSize

For i = 1 to 3
    With ActiveSheet.Shapes("List Box " & i)
        .Top = currentTop
        If .Visible Then currentTop = currentTop + .Height + gapSize
    End With

    With ActiveSheet.Shapes("Check Box " & (i+1))
        .Top = currentTop
        If .Visible Then currentTop = currentTop + .Height + gapSize
    End With
Next i

ActiveSheet.Shapes("List Box 4").Top = currentTop