Beyond Excel: VBA and Database Manipulation

Jul 13 2010   10:12AM GMT

Check Entry – The Controlling Routine

Craig Hatmaker Craig Hatmaker Profile: Craig Hatmaker

You are here (Click to enlarge)

You are here (Click to enlarge)

We have been working from the bottom up and now we get to the routine that controls the validation process: Check_Entry.  I almost never change Check_Entry but I put it in the spreadsheet class along with Cust_Edit because it is meant to be modified for worksheet specific validation rules.

Cust_Edit is a field level validation routine.  Often, that’s all you need.  On some occasions you need record set validations.  Such is the case with journal entries where the sum of debits must equal the sum of credits.  Check_Entry is the perfect place for such record set validations.  To implement a rule like this you could code a debit and a credit tally and check them after looping through the entire entry set.  If the tallies don’t match, set Check_Entry to Failure so the Post routine won’t save anything. 

Here is the code: 

Public Function Check_Entry(rngTarget As Range, _
                            sDataRange As String, _
                            sDataFieldDefinitions As String) As Boolean

'   Description:Determine if an entry is valid or not and NOTHING else
'               DO NOT attempt to correct or change values here
'               Do that in the Set_Entry_Defaults routine.

'   Parameters: rngTarget   Range to be validated
'               sDataRange  Range holding rngTarget and all other entries
'               sDataFieldDefinitions   Range containing field definitions
'                           for sDataRange
'   Example:    Me.Check_Entry Target(Range("Data_Data"), "Data", "Fields")
 
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    
    On Err GoTo ErrHandler
    Check_Entry = Success           'Assume the best
    
    If lColACD = 0 Then _
        Worksheet_Activate          'Set globals if needed
        
    Settings "Save"                 'Save current settings
    Settings "Disable"              'Disable events, screen updates, & calcs
           
    Dim lRow As Long                'Current Row
    Dim lCol As Long                'Current Column
    
    Dim lRowData As Long            'First Row of Data
    Dim lColData As Long            'First Column of Data
    Dim lRowsData As Long           'Total Rows in Data
    Dim lColsData As Long           'Total Columns in Data
    Get_Range_Dimensions Range(sDataRange), _
        lRowData, lRowsData, lColData, lColsData
    
    Dim lRowTarget As Long          'First Row in Target
    Dim lColTarget As Long          'First Column in Target
    Dim lRowsTarget As Long         'Total Rows in Target
    Dim lColsTarget As Long         'Total Columns in Target
    Get_Range_Dimensions rngTarget, _
        lRowTarget, lRowsTarget, lColTarget, lColsTarget
    
    With frmProgress                'Show progress bar
        .pCaption = "Checking for Errors"
        .pPct = 0
        If lRowsTarget > 1 Then .Show False
    End With
                
   'Loop through all rows
    For lRow = lRowTarget To lRowTarget + lRowsTarget - 1
    
       'Update Progress Bar
        If frmProgress.Visible Then _
            frmProgress.pPct = (lRow - lRowTarget) / lRowsTarget
                
       'Only process Adds or Changes
        If InStr(1, "AC", Cells(lRow, lColACD)) > 0 Then
            Cells(lRow, lColERRORS) = ""    'Clear Error message
            
           'Loop through all cells in this row
            For lCol = lColTarget To lColTarget + lColsTarget - 1
                
               'Don't check locked cells.  The user can't change them
                If Not Cells(lRow, lCol).Locked And _
                   Cells(lRow, lCol).Interior.Color <> CellChecked Then
                    Cell_Unlock Cells(lRow, lCol)   'Clear red fill
                    
                   'Select method for validating based on column header
                    Select Case Cells(lRowData, lCol)
                    
                    'NOTE TO PGMR: Add custom validation code here
                    'NOTE TO PGMR: End modifications
 
                        Case Else   
                            Check_Entry = _
                                Check_For_Normal_Entry_Errors( _
                                    Me.Name, _
                                    sDataFieldDefinitions, _
                                    lCol - lColData + 1, _
                                    Cells(lRow, lCol), _
                                    Cells(lRow, lColERRORS))
                    End Select
                    
                End If
            Next lCol
        End If
    Next lRow
    
ErrHandler:
    
    If Err.Number <> 0 Then MsgBox _
        "Check_Entry - Error#" & Err.Number & vbCrLf & Err.Description, _
        vbCritical, "Error", Err.HelpFile, Err.HelpContext
    If frmProgress.Visible Then frmProgress.Hide
    On Error Resume Next
    Settings "Restore"                  'Restore previous settings
    On Error GoTo 0
 
End Function
 
 
 
Function Get_Range_Dimensions( _
            Range As Range, _
            StartRow As Long, TotalRows As Long, _
            StartCol As Long, TotalCols As Long) As Boolean
  
'   Description:Returns basic dimensions of a range
 
'   Parameters: Range       Range for which dimensions are desired
'               StartRow    Upper left row of the range
'               TotalRows   Number of rows in the range
'               StartCol    Upper left column of the range
'               TotalCols   Number of columns in the range
 
'   Example:    Get_Range_Dimentions Range("Data"), _
                    lRow, lRows, lCol, lCols
 
'     Date   Init Modification
'   01/01/01 CWH  Initial Programming
    
    On Error GoTo ErrHandler            '
    Get_Range_Dimensions = Failure      'Assume the worst
        
    StartRow = Range.Row
    TotalRows = Range.Rows.Count
    StartCol = Range.Column
    TotalCols = Range.Columns.Count
    
    Get_Range_Dimensions = Success      'Successful finish
 
ErrHandler:
    
    If Err.Number <> 0 Then MsgBox _
        "Get_Range_Dimensions - 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: