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!

 

[Yongle]

Does your table start in row 1? - if it does not add the first row number to everything below

5 Message boxes added to code
Replace existing code with code below
Scroll manually so that you can see row 40 but select the TOP visible row
After going through 5 messages boxes it should scroll up one line
Then on the same screen select a cell in last visible row (no 65?)
After going through 5 messages boxes it should scroll down one line
If that happpens then the code is working, if it doesn't then let me know what the 5 message boxes return

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim tbl As Object
On Error Resume Next
Set tbl = Target.ListObject
MsgBox "1 Table Row Count " & tbl.DataBodyRange.Rows.Count
MsgBox "2 Selection row no (A) " & Selection.Row
MsgBox "3 Scroll row no (A) " & ActiveWindow.ScrollRow
If tbl.DataBodyRange.Rows.Count < 26 Then GoTo TheEnd
On Error GoTo TheEnd
    With ActiveWindow
    MsgBox "4 Selection row no (B) " & Selection.Row
    MsgBox "5 Scroll row no (B) " & .ScrollRow
        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

 

[Hart]

Does your table start in row 1? - if it does not add the first row number to everything below

5 Message boxes added to code
Replace existing code with code below
Scroll manually so that you can see row 40 but select the TOP visible row
After going through 5 messages boxes it should scroll up one line
Then on the same screen select a cell in last visible row (no 65?)
After going through 5 messages boxes it should scroll down one line
If that happpens then the code is working, if it doesn't then let me know what the 5 message boxes return

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim tbl As Object
On Error Resume Next
Set tbl = Target.ListObject
MsgBox "1 Table Row Count " & tbl.DataBodyRange.Rows.Count
MsgBox "2 Selection row no (A) " & Selection.Row
MsgBox "3 Scroll row no (A) " & ActiveWindow.ScrollRow
If tbl.DataBodyRange.Rows.Count < 26 Then GoTo TheEnd
On Error GoTo TheEnd
    With ActiveWindow
    MsgBox "4 Selection row no (B) " & Selection.Row
    MsgBox "5 Scroll row no (B) " & .ScrollRow
        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

The table data starts in row2, the header is row 1

I can see row 40 and clicked in cell a2 (first row of data)
Message box:

1 tablerow count 17
when i click ok,
2 Selection row no(A)2
when I click ok,
3 Scroll row no (A)2
when I click ok,
message box disappears

Thank you!

 

[Yongle]

per request in post#1

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)

per message box
tablerow count 17

VBA is ignoring scroll because the table has only 17 rows (that is what you asked for)

Add more data to your table so that it has 40 rows and test it again

 

[Hart]

Sorry, I had removed rows at one time to see if the scrolling stopped. I have made it 40 rows
1 Table row count 40
2 selection row no(a) 38
3 scroll no(a) 3
4 selection row no(b) 38
5 scroll no (b) 3

 

[Yongle]

If you were testing to see if scrolling stopped ... .... then the scrolling must be working for you... .. so what is the problem?

 

[Hart]

Clearly, I haven't expressed what I need to do - apologies.

I have created a macro which when initiated via a shortcut key combination, scrolls through a table. I want that macro (which I included earlier in the thread) to recognize when scrolling is not required - based on the table size. Sorry for not being more clear.
Hart

 

[Yongle]

No Problem
- will dovetail the 2 together for you when I get a chance - probably Sunday

 

[Hart]

Thanks, for all your help.

 

[Yongle]

Is this what you are looking for
- if number of data rows in Table2 exceeds 25 then run the macro

Sub Scroll_Start()
If ActiveSheet.ListObjects("Table2").DataBodyRange.Rows.Count > 25 Then
    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 If
End Sub

or maybe this so that zoom and full screen happens regardless

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