Beyond Excel: VBA and Database Manipulation

Aug 9 2010   8:13PM GMT

Check Entry – Worksheet_Change – Code

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

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


            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


        sKey = “Mouse”

    End If


   Disallow all total column oriented actions

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


        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


        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



        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





    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:

Share this item with your network: