Conditional scrolling macro

[Hart]

Hi all.
I would like to create a macro which would scroll through a table if there are too many rows to fit on the display. For example, if the table had more than 25 rows, scroll until the last row is displayed. Once the end of the table is reached, the scroll would return to the first entry in the table and repeat.
If the table had <= 25 rows, no scrolling is required.
Something like:
if rows(table1)<=25 then no scroll
else scroll to end of table (and repeat)

Thanks!

 

[Hart]

Hi all.
I would like to create a macro which would scroll through a table if there are too many rows to fit on the display. For example, if the table had more than 25 rows, scroll until the last row is displayed. Once the end of the table is reached, the scroll would return to the first entry in the table and repeat.
If the table had <= 25 rows, no scrolling is required.
Something like:
if rows(table1)<=25 then no scroll
else scroll to end of table (and repeat)

Thanks!

The following code will scroll but with a fixed number of rows(17 in the example below). The rows(table2) function returns the size of the table which will determine the size of the scrolling parameter. Any suggestions?

Public NextTime As Date

Sub Scroll_Start()
NextTime = Now + TimeValue("00:00:02") 'Two second interval
ActiveWindow.Zoom = 125
Application.DisplayFullScreen = True
If ActiveWindow.VisibleRange.Rows(1).Row < 17 Then
ActiveWindow.SmallScroll Down:=1
Else
ActiveWindow.ScrollRow = 1
End If
Application.OnTime NextTime, "Scroll_Start"
End Sub

Thanks.

 

[Yongle]

Hi Hart
Try this...

Code...
- assumes that there is only one table on the sheet
- user is scrolled to selected cell row if inside table
- if row below table is selected user is scrolled to top of table

Put in sheet module (right click sheet tab \ View Code \ paste in window on right)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim tbl As Object
On Error Resume Next
Set tbl = Target.ListObject
If tbl.DataBodyRange.Rows.Count < 26 Then GoTo TheEnd
On Error GoTo TheEnd

ActiveWindow.ScrollRow = Selection.Row
Target.Select
Exit Sub

TheEnd:
On Error Resume Next
With ActiveSheet.ListObjects(1)
    If Target.Row > .Range.Offset(.Range.Rows.Count - 1).Resize(1).Row Then
        ActiveWindow.ScrollRow = .Range.Resize(1).Row
    End If
End With

End Sub

 

[Yongle]

or similar but different
- table scrolls up one row when first row in window is selected
- table scrolls down when other rows selected
- click below table to scroll to top of table

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim tbl As Object
On Error Resume Next
Set tbl = Target.ListObject
If tbl.DataBodyRange.Rows.Count < 26 Then GoTo TheEnd
On Error GoTo TheEnd
    With ActiveWindow
        If Selection.Row - .ScrollRow = 1 Then
            .ScrollRow = .ScrollRow - 1
        Else
            .ScrollRow = .ScrollRow + 1
        End If
    End With
Exit Sub

TheEnd:
On Error Resume Next
With ActiveSheet.ListObjects(1)
    If Target.Row > .Range.Offset(.Range.Rows.Count - 1).Resize(1).Row Then
        ActiveWindow.ScrollRow = .Range.Resize(1).Row
    End If
End With

End Sub

 

[Yongle]

another variation
- scrolls up when first row in window is selected and down if 25th row (or greater) is selected

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim tbl As Object
On Error Resume Next
Set tbl = Target.ListObject
If tbl.DataBodyRange.Rows.Count < 26 Then GoTo TheEnd
On Error GoTo TheEnd
    With ActiveWindow
        Select Case Selection.Row - .ScrollRow
            Case Is < 2: .ScrollRow = .ScrollRow - 1
            Case Is > 24: .ScrollRow = .ScrollRow + 1
        End Select
    End With
Exit Sub

TheEnd:
On Error Resume Next
With ActiveSheet.ListObjects(1)
    If Target.Row > .Range.Offset(.Range.Rows.Count - 1).Resize(1).Row Then
        ActiveWindow.ScrollRow = .Range.Resize(1).Row
    End If
End With

End Sub

 

[Yongle]

per Private Message: I have inserted the code as suggested but it there is no change to the behaviour.

Hart

My code assumes that you are using a defined Excel Table ( created with Insert \ Table)
- Are you using an Excel Table or data that is tabulated ?

 

[Hart]

It is an Excel Table.

 

[Yongle]

Have you placed the code in the SHEET module?

 

[Hart]

Yes

 

[Hart]

At least I think so. Followed the instructions above.