Beyond Excel: VBA and Database Manipulation

Sep 23 2010   7:45PM GMT

Controlling the Cursor: Find_Unlocked_Cell

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

Today’s little routine was repeated all throughout Position_Cursor_In_Data (See previous post).  It’s a simple little routine with not much to talk about except one little trick:

v = Intersect(ActiveWindow.VisibleRange, Selection)

If you look closely at this routine, the variable “v” is never used.  So why is it there?  Answer: To cause an error.  Purposefully causing an error may sound crazy.  Well, there may be a better way, but it’s not crazy.  If the newly selected cell happens to be outside the visible window, attempting to intersect the selection with the visible window will fail causing error #91.  If that happens, we want to shift the window to display the selection with a call to Position_Window_to_Cursor.

Here is the code.

 

Function Find_UnLocked_Cell(lRowFrom As Long, lRowTo As Long, _
                            lColFrom As Long, lColTo As Long, _
                            lStep As Long) As Boolean
'   Description:Find the next unlocked cell
'   Parameters: lRowFrom        Starting Row
'               lRowTo          Ending Row
'               lColFrom        Starting Column
'               lColTo          Ending Column
'               lStep           Direction (-1=backward)
'   Example:    bFound = Find_UnLocked_Cell(Selection.Row, Selection.Row, _
'                                           Selection.Column + 1, _
                                            Range("Data").Columns.Count, 1)
'     Date   Init Modification
'   01/12/06 CWH  Initial Programming
    On Error GoTo ErrHandler    '
    Find_UnLocked_Cell = False  'Assume the Worst
   
    Dim lRow As Long
    Dim lCol As Long
    Dim v As Variant
   
    For lRow = lRowFrom To lRowTo Step lStep
        For lCol = lColFrom To lColTo Step lStep
            If Cells(lRow, lCol).Interior.Color <> CellLocked Then
                Cells(lRow, lCol).Select
                Find_UnLocked_Cell = True
                v = Intersect(ActiveWindow.VisibleRange, Selection)
                Exit Function
            End If
        Next lCol
    Next lRow
ErrHandler:
   
    If Err.Number = 91 Then
        Position_Window_to_Cursor Selection
    ElseIf Err.Number <> 0 Then _
        MsgBox _
        "Find_UnLocked_Cell - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    End If
    On Error GoTo 0
End Function
 
 
Function Position_Window_to_Cursor(rngCursor As Range) As Boolean
'   Description:Positions the window/pane so the cursor is visible
'   Parameters: rngCursor   The cursor's cell/range
'   Example:    bResult = Position_Window_to_Cursor(Selection)
'     Date   Init Modification
'   12/14/09 CWH  Initial Programming
    On Error GoTo ErrHandler
    Position_Window_to_Cursor = Failure  'Assume the Worst
   
    Dim iPaneRow As Integer
    Dim iPaneCol As Integer
    Dim lRow As Long
    Dim lCol As Long
       
    lRow = rngCursor.Row
    lCol = rngCursor.Column
   
    With ActiveWindow
   
        If lRow > .SplitRow + 1 Then
            iPaneRow = .Panes.Count
        Else
            iPaneRow = 1
        End If
        If lCol > .SplitColumn + 1 Then
            iPaneCol = .Panes.Count
        Else
            iPaneCol = 1
        End If
       
        lRow = rngCursor.Row - _
               .Panes(iPaneRow).VisibleRange.Rows.Count + 2
        If lRow <= .SplitRow Then lRow = .SplitRow + 1
        .Panes(iPaneRow).ScrollRow = lRow
       
        lCol = rngCursor.Column - _
               .Panes(iPaneCol).VisibleRange.Columns.Count + 2
        If lCol <= .SplitColumn Then _
            lCol = .SplitColumn + 1
        .Panes(iPaneCol).ScrollColumn = lCol
   
    End With
   
    Position_Window_to_Cursor = Success
   
ErrHandler:
   
    If Err.Number <> 0 Then MsgBox _
        "Position_Window_to_Cursor - Error#" & Err.Number & vbCrLf & _
        Err.Description, vbCritical, "Error", Err.HelpFile, Err.HelpContext
    On Error GoTo 0
End Function

 Comment on this Post

 
There was an error processing your information. Please try again later.
Thanks. We'll let you know when a new response is added.
Send me notifications when other members comment.

REGISTER or login:

Forgot Password?
By submitting you agree to receive email from TechTarget and its partners. If you reside outside of the United States, you consent to having your personal data transferred to and processed in the United States. Privacy

Forgot Password

No problem! Submit your e-mail address below. We'll send you an e-mail containing your password.

Your password has been sent to: