Beyond Excel: VBA and Database Manipulation

Aug 9 2010   8:13PM GMT

Check Entry – Worksheet_Change – Code



Posted by: Craig Hatmaker
Tags:
database
development
excel
Microsoft Excel
ms query
odbc
sql
tutorial
vba

Last post we discussed the theory behind the WorkSheet_Change event code below.  This code must be in the WorkSheet class as it only responds to events for the worksheet that contains it.  Here is the code: 

Private Sub Worksheet_Change(ByVal Target As Range)

 

   Purpose:    Invoke routines to set/check the contents of entry cells

 

   Parameters: Target      Range that was changed

 

   Example:    None – this is an event handler

 

    On Error GoTo ErrHandler

   

    Dim bResult As Boolean

   

    Settings “Save”                 ‘Save current application settings

    Settings “Disable”              ‘Disable events, screen updates, & calcs

       

   Determine the last key pressed

    Dim sKey As String

    Dim lRow As Long

    Dim lCol As Long

    If GetAsyncKeyState(vbKeyTab) And &H8000 Then

        If GetAsyncKeyState(vbKeyShift) And &H8000 Then

            sKey = “ShiftTab”

            lCol = lCol – 1

        Else

            sKey = “Tab”

            lCol = lCol + 1

        End If

    ElseIf GetAsyncKeyState(vbKeyRight) And &H8000 Then

        sKey = “Right”

        lCol = lCol + 1

    ElseIf GetAsyncKeyState(vbKeyLeft) And &H8000 Then

        sKey = “Left”

        lCol = lCol – 1

    ElseIf GetAsyncKeyState(vbKeyPageUp) And &H8000 Then

        sKey = “PageUp”

        lRow = lRow – 1

    ElseIf GetAsyncKeyState(vbKeyUp) And &H8000 Then

        sKey = “Up”

        lRow = lRow – 1

    ElseIf GetAsyncKeyState(vbKeyDown) And &H8000 Then

        sKey = “Down”

        lRow = lRow + 1

    ElseIf GetAsyncKeyState(vbKeyPageDown) And &H8000 Then

        sKey = “PageDown”

        lRow = lRow + 1

    ElseIf GetAsyncKeyState(vbKeyReturn) And &H8000 Then

        sKey = “Return”

        lRow = lRow + 1

    Else

        sKey = “Mouse”

    End If

       

   Disallow all total column oriented actions

    If Target.Rows.Count = Me.Rows.Count Then

        Application.Undo

        MsgBox “You  may not paste, delete, or insert columns”, _

            vbInformation, “Column changes not allowed”

   

   Allow without checking all total row oriented actions _

    that are below the header row.  Execute the code below for all else

    ElseIf Target.Columns.Count < Me.Columns.Count _

        Or Target.Row <= Range(sData).Row Then

          

          

   Handle pasting ‘locked’ cells

       Remember Current Cursor Position

        Dim rngSelection As Range

            Set rngSelection = Selection

 

       Restrict Target to appropriate range

        Set Target = Intersect(Target, _

                     Range(sData).EntireColumn, _

                     Rows(Range(sData).Row + 1 & “:” & Me.Rows.Count))

           

       Remember Target

        Dim rngCell As Range

        Dim colAddress As New Collection

        Dim colValue As New Collection

        If Not Target Is Nothing Then

            For Each rngCell In Target

                colAddress.Add rngCell.Address

                colValue.Add rngCell.Value

            Next

        End If

   

        Application.Undo    ‘Undo Changes

   

       Repaste values to unlocked cells as unlocked cells

        Dim i As Integer

        For i = 1 To colAddress.Count

            If Not Range(colAddress.Item(i)).Locked Then _

                Range(colAddress.Item(i)) = colValue.Item(i)

        Next i

 

        rngSelection.Select      ‘Restore Selection

       

       Detail

        Cell_UnChecked Target

        If NameExists(sData) Then

            bResult = Set_Entry_Defaults(Target, sData, sFields)

            If bResult = Success Then Check_Entry Target, sData, sFields

            Format_New_Line sData, sFields

        End If

       

        If bResult <> Success Then Set Target = Selection

        Position_Cursor_In_Data _

            Target.Cells(1 + lRow, 1 + lCol), Range(sData), sKey

       

    End If

           

   

ErrHandler:

   

    If Err.Number <> 0 Then MsgBox _

        Me.Name & “.WorkSheet_Change – Error#” & Err.Number & vbCrLf & _

        Err.Description, vbCritical, “Error”, Err.HelpFile, Err.HelpContext

    On Error Resume Next

    Settings “Restore”              ‘Restore application settings

    On Error GoTo 0

 

End Sub

 

 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: