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

        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

 

2  Comments 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
  • SophiaDD
    HiCraig! Your posts are so useful and they have been helping me out so many times. Thank you! But there are times when I don't understand somethings. This is one of the many times that happens. Would you mind going over what this line means? I see "&H8000" often but never understand it.
    GetAsyncKeyState(vbKeyTab) And &H8000
    0 pointsBadges:
    report
  • Craig Hatmaker
    Great question. I should have explained it a lot better especially because this gets into the realm of BINARY, something most VBA coders are completely unfamiliar with. We want to know if the tab key is being pressed so we call a Windows API "GetAsyncKeyState" which keeps track of what is going on with our computer's keyboard. Here is how to declare the API. Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer The API returns an Integer value which is really a 16-bit switch where each bit is a switch containing a 1 (ON) or 0 (OFF). A 16 bit binary switch looks something like this 1000100011110000. If our API sets the most significant bit to 1, the key is down. This is the only bit we are concerned with. We want to ignore all other bits. To "Mask" out all of the other bits we use a Binary AND Operator. The Binary AND Operation compares each bit in two numbers. Where both bits equal 1 the Binary AND operation result is 1 (ON), otherwise, it is 0 (OFF). So if the API returns 1000100011110000 and we only want the left most switch we Binary AND it with 1000000000000000. But VBA doesn't understand 1000000000000000 as a binary value. To tell VBA we want it to use a Binary AND Operation instead of a normal VBA AND, we have to tell VBA that we are not using normal numbers, rather one of the representations of Binary numbers. Hexadecimal is one such representation that VBA understands. &H tells VBA the number that follows is a Hexadecimal number. &H8000 is the hexadecimal number 8000. And in hexadecimal 8 equals 1000 in Binary. So Hexadecimal 8000 is Binary 1000000000000000. Coming full circle, ANDing &H8000 with GetAsyncKeyState(vbKeyTab) tells us if the tab key is currently held down. Hope that helps. For more information Google "Wikipedia Hexadecimal", "MSDN GetAsyncKeyState", and "Binary AND Operation"
    1,855 pointsBadges:
    report

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: