Add a scrollbar to a list with checkboxes.

[hpohl]

I have a list of 30 rows and 11 columns (B6:L34)
In the first column, every cell has a drop down list referring back to the same data... and in 3 of the columns there are checkboxes (form controls). I want to make this list scroll so that only 10 of the rows are visible at a time instead of all 30 in order to shorten the overall table.

I know that there are ways to add scrollbars through form controls, but I can't get it to work with all of the data already entered?
Any ideas?!

[natefarm]

I think the code below will do what you want, but it's going to take some work with your controls to set it up. The complication is that if you right-click your form controls and select Format Control, then Properties, you will see that "Move and size with cells" is disabled (at least it is for me), so we need to include that in the code, which I have done.

The first thing you need to do make sure the controls are all set to "Move but don't size with cells". I think that's the default, but check a few to be sure. If they're not, you can multi-select them and do them all at once.

Next, your going to need to rename all your controls so the names match the row they sit on. That way the code can find them. This will be the biggest pain because you'll have to do them one at a time. First, paste the following into the Immediate pane of the VBA window:

ActiveSheet.Shapes("Drop Down N").name = "DropDownR"
ActiveSheet.Shapes("Check Box N").name = "CheckBoxRC"

Next, right-click the first drop-down and observe the name in the name field (where the cell name appears when you select a cell). In the Immediate pane, replace the N with the number so it matches the name, and change the R so it matches the row that the control is sitting on (for example, if Drop Down 1 is in row 6, rename it to DropDown6). With the cursor still on that line in the Immediate pane, press Enter. If you unselect and reselect that control, it should now have the new name. Repeat this for all the drop-downs.

Do the same thing with the checkboxes, except that since you have multiple checkboxes on each row, include the column number also so they will each have a unique name (Check Box 2 becomes CheckBox2F, Check Box 3 becomes CheckBox2G, etc.)

Once that's all done, it wouldn't hurt to save the workbook . Next, add a scrollbar control, select Properties, and change the Max value to 20. Close Properties, right-click the control and select Format Control, Properties, and "Don't move and size with cells".

Finally, in the code window, Project Explorer, double-click the sheet containing the controls, and paste the following code into it. I've set it up to handle two checkboxes (F & G) in each row. You can adjust as needed. It also has constants for the specifications you gave, which can also be adjusted. Just remember that if you adjust the VisibleRws or TotalRws values, you may also need to adjust the Max value in the scrollbar control to match. If it blows up when you scroll, go into debug and check the row and control names it's trying to work with to make sure they match actual control names.

Good luck!

Dim rw As Long
Const FirstRw = 6, VisibleRws = 10, TotalRws = 30

Private Sub ScrollBar1_Change()
    Application.ScreenUpdating = False
    rw = FirstRw

    Do Until rw = ScrollBar1.Value + FirstRw ' Hide the rows above
        Call ShowHide(True)
    Loop

    Do Until rw = ScrollBar1.Value + FirstRw + VisibleRws ' Show the 10 desired rows
        Call ShowHide(False)
    Loop

    Do Until rw = FirstRw + TotalRws ' Hide the rows below
        Call ShowHide(True)
    Loop
End Sub

Sub ShowHide(Hide As Boolean)
    If Not Rows(rw).Hidden = Hide Then
        Rows(rw).Hidden = Hide
        Call ShowHideControl("DropDown" & rw, Hide)
        Call ShowHideControl("CheckBoxF" & rw, Hide)
        Call ShowHideControl("CheckBoxG" & rw, Hide)
    End If
    rw = rw + 1
End Sub

Sub ShowHideControl(CtrlName As String, Hide As Boolean)
    With Shapes(CtrlName)
        .Visible = Not Hide
        If .Visible Then
            .Top = Rows(rw).Top + 1
        End If
    End With
End Sub