OnKey method to control scrolling

[ajh1]

I have a block of cells on my Excel worksheet that I have attached scroll bars to. The scroll bars work fine, but one of my users asked if he could activate the scroll function by pressing the downarrow in the last row, the uparrow in the top row, etc.
I keyed it to the Worksheet_SelectionChange event as follows:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Test for edges of scrolling areas
'Expanded Input zone

If ActiveCell.row = 31 And (ActiveCell.Column >= 3 And ActiveCell.Column <= 16) Then
'check for uparrow movement
Application.OnKey "{UP}", Scroll_VBayPurlin(-1)
Application.OnKey "{UP}"
Else
Application.OnKey "{UP}"
End If

(Similar for other 3 directions)

This logic works in the sense that when I first enter the cell moving with an arrow key from an adjacent cell, it will do the scroll.

I have two problems:
1) It doesn't seem to make any difference which key (or mouse process)I used to get to the cell, the scroll activates. It is almost like I have an OnKey "ANY" if such existed. Because each of the OnKey calls activates regardless of the key pressed, I actually scroll both horizontally and vertically in sequence when I move into a corner cell of the scroll area. How does one get the OnKey procedure to recognize only the specified key activity and ignore the process if it is not the correct key.

2) Because it runs off the SelectionChange event the scroll only happens once unless I move out of the cell and back in again. A second arrow click moves the ActiveCell to the adjacent cell. Using the opposing arrow to move back into the scroll area activates the scroll once again (in the opposite direction of the actual arrow key that I pressed).
Any suggestions so that I can do multiple arrow keystrokes simultaneously within a single cell.

I appreciate any insights you might give me.

Thanks.

 

[ajh1]

I failed to mention I'm running Excel 2007 if that has any significance.

 

[SkipVought]

Hi,

What are keystrokes going to do for your scroll? Don't you want to change the scroll control index directly?

Also, the Selction_Change event only fires when you, er uh well, CHANGE the SELECTION. So repeatedly "clicking" in the same cell changes nothing. You COULD, however, at the end of the procedure, select a cell outside of the hot area, like A1.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ajh1]

The procedure scrollVBayPurlin that I have the OnKey process go to is manipulating the scroll control index. That aspect of the puzzle works fine. The problem is that it activates due to any action in the cell, not just the specified arrow.
As I had indicated I've got scroll bars around the area, but one of my users would like to just force the area to scroll as he moves in the cells, rather than having to go over and click the scroll bar.
I've about decided I need to use something other than SelectionChange to drive this as I would like to activate it as part of leaving the cell, not moving into it.
I'm open to most any suggestion at this point.
I've already told the guy he needs to just use the scroll bars, but since I'm sure there is some way to do what he would like to do, I decided to dig into it a bit on a test copy.

Thanks for your input.

Al..

 

[SkipVought]

The problem is that it activates due to any action in the cell, not just the specified arrow.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Test for edges of scrolling areas
    'Expanded Input zone

    If Target.Row = 31 And (Target.Column >= 3 And Target.Column <= 16) Then
        'check for uparrow movement
        Application.OnKey "{UP}", "hello"[b]
'        Application.OnKey "{UP}"  Can't turn it off here, can you???[/b]
    Else
        Application.OnKey "{UP}"
    End If

End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[SkipVought]

sorry, I forgot to put your scroll procedure back in, over my "hello" proc.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ajh1]

The reset with the second OnKey line was an attempt to keep from having the functionality stick if I moved to a cell that was not at the edge of the scroll zone. It also seemed to provide some benefit to keeping the msgbox stating "Macro '0' couldn't be found" when I got to the limit of the scrolling index although I can't seem to duplicate that issue this morning with any regularity.

For completeness here is the routine that the OnKey process calls. I hadn't included it before as this part of the operation seems to work as expected, if only I could keep from calling for anything other than the desired keystroke.

Function Scroll_VBayPurlin(scrollAmount As Integer) As Long
'Function will cause scroll movement up or down for appropriate cells
If Worksheets("ProdInput").scrVBayPurlin.value + scrollAmount < Worksheets("ProdInput").scrVBayPurlin.Min Or _
Worksheets("ProdInput").scrVBayPurlin.value + scrollAmount > Worksheets("ProdInput").scrVBayPurlin.Max Then
'No action
Else
Worksheets("ProdInput").scrVBayPurlin.value = Worksheets("ProdInput").scrVBayPurlin.value + scrollAmount
End If
End Function

 

[SkipVought]

I believe that you will have a problem with this syntax

Application.OnKey "{UP}", Scroll_VBayPurlin(-1)

According to HELP, the procedure argument requires a STRING, not a subroutine.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ajh1]

Interesting. It appears like it goes there 100% of the time when it is not shown as a string, but only goes to the routine when it is a string, if the onKey check is met. I'll have to create an intermediate routine to get my plus or minus counter working as I crash the other routine with "missing parameter" when I don't (can't) pass the plus or minus 1 value.

I wonder what would happen if I set the target cells in my checking to the band of cells just outside of the scrolling area. I have tended to lock out all cells in the spreadsheet other than where I want the user to have input capability so that might put a damper on the process.

Thanks for all your help. With VBA it always seems to be the really subtle errors that show up.

Al..

 

[SkipVought]

I'd suggest NAMING the scroll area, including the click-in range with a Named Range. I used ScrollArea

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Test for edges of scrolling areas
    'Expanded Input zone
    Dim lFirst As Long, lLast As Long, iFirst As Integer, iLast As Integer

    With Range("ScrollArea")
        lFirst = .Row
        lLast = .Rows.Count + lFirst - 1
        iFirst = .Column
        iLast = .Columns.Count + iFirst - 1
    End With

    If Not Intersect(Target, Range("ScrollArea")) Is Nothing Then
        Select Case Target.Row
            Case lFirst
                Application.OnKey "{DOWN}", "down"
            Case lLast
                Application.OnKey "{UP}", "up"
            Case Else
                Select Case Target.Column
                    Case iFirst
                        Application.OnKey "{RIGHT}", "right"
                    Case iLast
                        Application.OnKey "{LEFT}", "left"
                    Case Else
                        GoSub CancelKeys
                End Select
        End Select
    Else
        GoSub CancelKeys
    End If
    Exit Sub
CancelKeys:
    Application.OnKey "{UP}"
    Application.OnKey "{DOWN}"
    Application.OnKey "{RIGHT}"
    Application.OnKey "{LEFT}"
    Return
End Sub

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[ajh1]

Thanks. I appreciate all of your help. I'm gotten distracted off onto some other stuff this morning, but I'll keep you posted if I discover any other nuances that would be helpful to others.

Al..

 

[DaveInIowa]

Please forgive me if I'm way off base with what you're trying to accomplish but, maybe this can be done without using OnKey and just trapping whether the user moved one cell outside the "Scroll Area". Obviously this won't work if the scroll area begins on row 1 or column 1.

Private prevActiveCell As Range
Private topScrollRow As Long
Private bottomScrollRow As Long
Private leftScrollColumn As Integer
Private rightScrollColumn As Integer

Private Sub Worksheet_Activate()
    Set prevActiveCell = ActiveCell
        
    With Me.Range("ScrollArea")
        topScrollRow = .Row
        bottomScrollRow = .Row + .Rows.Count - 1
        leftScrollColumn = .Column
        rightScrollColumn = .Column + .Columns.Count - 1
    End With

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Static resettingActiveCell As Boolean
    
    If (resettingActiveCell) Then
        resettingActiveCell = False
        Exit Sub
    End If
    
    If (Target.Cells.Count > 1) Then Exit Sub
    
    If (prevActiveCell Is Nothing) Then Worksheet_Activate
    
    If (Target.Row = prevActiveCell.Row - 1 And Target.Row = topScrollRow - 1) Then 'User moved up
        If (HScrollBar.Value > HScrollBar.Min) Then HScrollBar.Value = HScrollBar.Value - 1
        resettingActiveCell = True
        prevActiveCell.Select
    
    ElseIf (Target.Row = prevActiveCell.Row + 1 And Target.Row = bottomScrollRow + 1) Then 'User moved down
        If (HScrollBar.Value < HScrollBar.Max) Then HScrollBar.Value = HScrollBar.Value + 1
        resettingActiveCell = True
        prevActiveCell.Select
    
    ElseIf (Target.Column = prevActiveCell.Column - 1 And Target.Column = leftScrollColumn - 1) Then 'User moved left
        If (VScrollBar.Value > VScrollBar.Min) Then VScrollBar.Value = VScrollBar.Value - 1
        resettingActiveCell = True
        prevActiveCell.Select
    
    ElseIf (Target.Column = prevActiveCell.Column + 1 And Target.Column = rightScrollColumn + 1) Then 'User moved right
        If (VScrollBar.Value < VScrollBar.Max) Then VScrollBar.Value = VScrollBar.Value + 1
        resettingActiveCell = True
        prevActiveCell.Select
    Else
        Set prevActiveCell = Target
    End If

End Sub

 

[ajh1]

Thanks for the input. I'm about at the point myself where I would like to throw away OnKey. Your concept makes sense for me, except one of my directions the cell I would be moving into is a cell where I expect the user could make an input so I would have to somehow recognize how I got there.
I'm going to take it up Monday as my brain is fried at the moment.

Enjoy your weekend.

Al..

 

[ajh1]

Skip and Dave, thank you both for your excellent suggestions. I ended up adopting a variation of what Dave proposed, as OnKey kept doing wierd things. One moment it would work, then it wouldn't work at all. The only little glitch remaining is that for my scroll up area, the row above the scrolling area is available to the user for other input (the other 3 directions are dead space). Because I don't have OnKey in the loop, I can't distinguish between an upArrow in the top row of scroll or a mouse movement that moves up the one row. Both cause the scrolling region to scroll if it isn't already at the top of the list. With a copy of extra checks, the expected functionality works if I upArrow or mouse when the scrolling is already maxed, or if I use the mouse but go to any other cell than the one directly above the previous active cell.
Short of reworking the sheet and building a dead row in that appears the best I can do.

Again, thanks to both of you for your help and excellent suggestions.

Al..

 

[DaveInIowa]

How about activating the scroll function only if the scroll bar is not at either limit?

    If (Target.Row = prevActiveCell.Row - 1 And Target.Row = topScrollRow - 1) Then 'User moved up
        [red]If (HScrollBar.Value > HScrollBar.Min) Then
            HScrollBar.Value = HScrollBar.Value - 1
            resettingActiveCell = True
            prevActiveCell.Select
        End If[/red]

        ... Similar code for the other 3 directions

 

[ajh1]

That's basically what I have, perhaps not so elegantly as you've shown, but it still leaves me with one gap.
If the first IF you show is true due to moving up one row with the mouse (as opposed to the upArrow) and the second IF is also true (scrolling has not minimumed out) the logic shown will scroll the scroll area, not position the cursor in the upper cell for other input.

Here's the logic I put in.
If (Target.row = prevActiveCell.row - 1 And _
Target.row = topScrollRowExpInput - 1 And _
Target.Column = prevActiveCell.Column) Then
'User moved up at top of scroll area
'Extra check on column is to try and minimize having the program
'scroll the main area when the way the user got between rows was via
'a mouse positioning rather than an uparrow.
'OnKey performance has been spotty. The extra check allows the user to
'move to any cell in row 30 from row 31 other than the one immediately above
'the previous active cell without triggering the scrolling function
'In addition, if the scroll has already reached its limit, an upArrow will
'move normally to line 30.
scrolled = Scroll_VBayPurlin(-1)
If scrolled Then
resettingActiveCell = True
prevActiveCell.Select
End If

The other 3 directions don't have a problem because the user has no reason to go to the new target cells.

 

[DaveInIowa]

Back to using OnKey, but instead of turning the arrow keys on and off, keep them active all the time and control movement within their associated subroutines:

Private Sub Worksheet_Activate()
    Application.OnKey "{UP}", "OnKeyUp"
    Application.OnKey "{DOWN}", "OnKeyDown"
    Application.OnKey "{LEFT}", "OnKeyLeft"
    Application.OnKey "{RIGHT}", "OnKeyRight"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    If (Target.Cells.Count = 1) Then
    
        Select Case OnKeyArrowDirection
            Case ""
                Application.StatusBar = "Changed via mouse click"
            Case "B"
                Application.StatusBar = "Busted out of scroll area using arrow key"
            Case Else
                Application.StatusBar = "Changed via " & OnKeyArrowDirection & " arrow key"
        End Select
        
    End If
            
    OnKeyArrowDirection = ""
    
End Sub

Public OnKeyArrowDirection As String

Private scrollArea As Range
Private topScrollAreaRow As Long
Private leftScrollAreaColumn As Integer
Private bottomScrollAreaRow As Long
Private rightScrollAreaColumn As Integer

Public Sub InitializeScrollArea()
    Set scrollArea = Range("ScrollArea")
    With scrollArea
        topScrollAreaRow = .Row
        leftScrollAreaColumn = .Column
        bottomScrollAreaRow = .Row + .Rows.Count - 1
        rightScrollAreaColumn = .Column + .Columns.Count - 1
    End With
End Sub

Public Sub OnKeyUp()

    If (ActiveCell.Row = 1) Then Exit Sub

    If (scrollArea Is Nothing) Then InitializeScrollArea

    If (Intersect(ActiveCell, scrollArea) Is Nothing Or ActiveCell.Row <> topScrollAreaRow) Then
        OnKeyArrowDirection = "U"
        ActiveCell.Offset(-1).Select
    ElseIf (Sheet1.HScrollBar.Value = Sheet1.HScrollBar.Min) Then
        OnKeyArrowDirection = "B" 'Bust out of scroll area
        ActiveCell.Offset(-1).Select
    Else
        Sheet1.HScrollBar.Value = Sheet1.HScrollBar.Value - 1
    End If
    
End Sub

Public Sub OnKeyDown()

    If (scrollArea Is Nothing) Then InitializeScrollArea

    If (Intersect(ActiveCell, scrollArea) Is Nothing Or ActiveCell.Row <> bottomScrollAreaRow) Then
        OnKeyArrowDirection = "D"
        ActiveCell.Offset(1).Select
    ElseIf (Sheet1.HScrollBar.Value = Sheet1.HScrollBar.Max) Then
        OnKeyArrowDirection = "B" 'Bust out of scroll area
        ActiveCell.Offset(1).Select
    Else
        Sheet1.HScrollBar.Value = Sheet1.HScrollBar.Value + 1
    End If
    
End Sub

Public Sub OnKeyLeft()

    If (ActiveCell.Column = 1) Then Exit Sub

    If (scrollArea Is Nothing) Then InitializeScrollArea

    If (Intersect(ActiveCell, scrollArea) Is Nothing Or ActiveCell.Column <> leftScrollAreaColumn) Then
        OnKeyArrowDirection = "L"
        ActiveCell.Offset(, -1).Select
    ElseIf (Sheet1.VScrollBar.Value = Sheet1.VScrollBar.Min) Then
        OnKeyArrowDirection = "B" 'Bust out of scroll area
        ActiveCell.Offset(, -1).Select
    Else
        Sheet1.VScrollBar.Value = Sheet1.VScrollBar.Value - 1
    End If
    
End Sub

Public Sub OnKeyRight()

    If (scrollArea Is Nothing) Then InitializeScrollArea

    If (Intersect(ActiveCell, scrollArea) Is Nothing Or ActiveCell.Column <> rightScrollAreaColumn) Then
        OnKeyArrowDirection = "R"
        ActiveCell.Offset(, 1).Select
    ElseIf (Sheet1.VScrollBar.Value = Sheet1.VScrollBar.Max) Then
        OnKeyArrowDirection = "B" 'Bust out of scroll area
        ActiveCell.Offset(, 1).Select
    Else
        Sheet1.VScrollBar.Value = Sheet1.VScrollBar.Value + 1
    End If
    
End Sub