Check Entry – Worksheet_Change – Code
Posted by: Craig Hatmaker
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
RSS Feed
Email a friend
