• Home
 · 
• Miscellaneous
 · 
• Validates an Excel Sheet.

Validates an Excel Sheet.

Validates an Excel Sheet.

Rate Validates an Excel Sheet.

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

Dim Row_Validation As Boolean

Sub Validate_Form()
    Dim Failed_Validation As Boolean
    
    'Check the Global Variables for each sheet to see if they have been
    'validated yet.  If not, fail the form validation.
     
    If Failed_Validation = True Then
        MsgBox "Form is not set up right"
    Else
        'Build XML file
        Build_XML
    End If
    
End Sub

Sub Build_XML()
    Dim xmldoc As MSXML2.DOMDocument
    Dim xmLstring As String
    Dim rowCntr As Integer
    Dim colCntr As Integer
    Dim fileLoc As String
    Dim cmdlg As New CommonDialog
    Dim strQuote As String
    

    xmLstring = ""
    rowCntr = 0
    colCntr = 0
    strQuote = """"
    
    Set xmldoc = CreateObject("Microsoft.XMLDOM")
    
    'Create Parent Node and add it to the string
    xmLstring = "<FORM Name=" & strQuote & Range("Audit_Form").Value & strQuote & "> "
    
    '-----------------------
    'CATEGORIES
    '-----------------------
    
        rowCntr = 8
        colCntr = 1
        
        Do While Worksheets("Categories").Cells(rowCntr, 1).Value <> ""
        
            'Add Item
            xmLstring = xmLstring & "<CATEGORY "
            For colCntr = 1 To 6 'There are only 6 columns
                
                Select Case colCntr
                    Case 1 ' Category ID
                        xmLstring = xmLstring & "Id=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                    Case 2 ' Parent Category
                        xmLstring = xmLstring & "Parent=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                    Case 3 'Category Name
                        xmLstring = xmLstring & "Name=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                    Case 4 'View Type
                        xmLstring = xmLstring & "Type=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                    Case 5 ' Category Answer
                        xmLstring = xmLstring & "Answer=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                    Case 6 'ReAudit
                        xmLstring = xmLstring & "Reaudit=" & strQuote & Worksheets("Categories").Cells(rowCntr, colCntr).Value & strQuote & " "
                End Select
                
            Next
            
            'Close the Item Tag
            xmLstring = xmLstring & "></CATEGORY>"
            
            'Move the counter to the next row
            rowCntr = rowCntr + 1
            
        Loop

    'Add the closing to the Parent Node
    xmLstring = xmLstring & "</FORM>"
    
    'Load it so it can be saved
    xmldoc.loadXML xmLstring
    
    'obtain file location
    cmdlg.ShowSave
    fileLoc = cmdlg.Filename
    
    'Save the file as XML
    xmldoc.Save (fileLoc)
    
    'Display successful save
    ActiveSheet.Hyperlinks.Add Anchor:=Cells(10, 2), Address:=fileLoc _
        , TextToDisplay:= _
        "File saved successfuly at: " & fileLoc
        
    
End Sub

Sub Validate_Catetory()
    Dim intBlankRow As Integer
    Dim rngBlankCell As Range
    Dim xxRow As Integer, yyCharPosition As Integer
    Dim strCategoryValue As String
    Dim strChar As String
    Dim strStartRow As Integer
    Dim strCategoryRange As String
    Dim strCatIDCol As String
    Dim strCatParentCol As String
    Dim strCatNameCol As String
    Dim strCatViewCol As String
    Dim strCatAnswerCol As String
    Dim strCatReAuditCol As String
    
        
    'Unprotect the sheet first
    Unprotect_Sheet "Categories"
    
    'Initialize Variables
    Cat_Failed_Validation = False
    Row_Validation = False
    strStartRow = 8
    strCatIDCol = "A"
    strCatParentCol = "B"
    strCatNameCol = "C"
    strCatViewCol = "D"
    strCatAnswerCol = "E"
    strCatReAuditCol = "F"
                
    'Determine the last row
    Set rngBlankCell = Sheets("Categories").Columns(1)
    intBlankRow = rngBlankCell.Find("", Range(strCatIDCol & strStartRow)).Row
    
    'Clear the comments
    strCategoryRange = "A" & strStartRow & ":F" & intBlankRow - 1
    Clear_Comments (strCategoryRange)
    
    'Reset the Font
    Reset_Font strCategoryRange
    
   
    For xxRow = strStartRow To intBlankRow - 1
        
        '-----------------------------
        'Check the Category ID
        '-----------------------------
            strCategoryValue = Range(strCatIDCol & xxRow).Value
            For yyCharPosition = 1 To Len(strCategoryValue)
                strChar = Mid(strCategoryValue, yyCharPosition, 1)
                Row_Validation = Check_ASCII(strChar)
                
                If Row_Validation = True Then
                    Color_Text (strCatIDCol & xxRow)
                    Add_Comment (strCatIDCol & xxRow), "The following are a list of accepted characters: a-z,A-Z,1-9,-,_  Spaces, etc. are not allowed."
                    
                    'set it for the next row
                    Row_Validation = False
                    
                    'Set Category Failure
                    Cat_Failed_Validation = True
                End If
    
            Next
            
        '-----------------------------
        'Check the Category Name (Required)
        '-----------------------------
        
            'Make sure a name exists
            strCategoryValue = Range(strCatNameCol & xxRow).Value
            If strCategoryValue = "" Then
                Color_Text (strCatNameCol & xxRow)
                Add_Comment (strCatNameCol & xxRow), "The Category Name is a required field."
                Cat_Failed_Validation = True
            End If
        
            'Check Length of Name (Max Characters = 20)
            
            If Len(strCategoryValue) > 20 Then
                Color_Text (strCatNameCol & xxRow)
                Add_Comment (strCatNameCol & xxRow), "The length of the Category Name cannot exceed 20 characters."
                Cat_Failed_Validation = True
            End If
            
        '-----------------------------
        'Check the View Type (Required)
        '-----------------------------
            strCategoryValue = UCase(Range(strCatViewCol & xxRow).Value)
            Select Case strCategoryValue
                Case ""
                    Color_Text (strCatViewCol & xxRow)
                    Add_Comment (strCatViewCol & xxRow), "The View Type is a required field."
                    Cat_Failed_Validation = True
                Case "CATEGORY LIST"
                    'No need to do anything
                Case "QUESTION LIST"
                    'No need to do anything
                Case Else
                    Color_Text (strCatViewCol & xxRow)
                    Add_Comment (strCatViewCol & xxRow), "Only the values: 'CATEGORY LIST' or 'QUESTION LIST' are allowed.  Please verify the spelling."
                    Cat_Failed_Validation = True
            End Select
                
        '-----------------------------
        'Check the Category Answer (Optional)
        '-----------------------------
            strCategoryValue = UCase(Range(strCatAnswerCol & xxRow).Value)
            Select Case strCategoryValue
                Case ""
                    'No need to do anything
                Case "ENABLED"
                    'No need to do anything
                Case "DISABLED"
                    'No need to do anything
                Case Else
                    Color_Text (strCatAnswerCol & xxRow)
                    Add_Comment (strCatAnswerCol & xxRow), "Only the values: 'ENABLED' or 'DISABLED' are allowed.  Please verify the spelling."
                    Cat_Failed_Validation = True
            End Select
                
        '-----------------------------
        'Check the ReAudit (Optional)
        '-----------------------------
            strCategoryValue = UCase(Range(strCatReAuditCol & xxRow).Value)
            Select Case strCategoryValue
                Case ""
                    'No need to do anything
                Case "AUDIT"
                    'No need to do anything
                Case "BOTH"
                    'No need to do anything
                Case "NON-COMPLIANT"
                    'No need to do anything
                Case "REAUDIT"
                    'No need to do anything
                Case Else
                    Color_Text (strCatReAuditCol & xxRow)
                    Add_Comment (strCatReAuditCol & xxRow), "Only the values: 'AUDIT', 'BOTH', 'NON-COMPLIANT', or 'REAUDIT' are allowed.  Please verify the spelling."
                    Cat_Failed_Validation = True
            End Select
    
    Next
    
    If Cat_Failed_Validation = True Then
        MsgBox "Validation Failed.  Please see the items in red and refer" & vbCrLf & _
                "the comments in the cell for clarification."
    Else
        MsgBox "Validation Successful"
    End If
    
    Range("A7").Select
    
    'Protect the sheet first
    Protect_Sheet "Categories"
    
End Sub

Function Check_ASCII(ByVal strChar As String) As Boolean
    Dim intASCII As Integer
    
    intASCII = Asc(strChar)
    
    'The following are the accepted characters in the ID field.
    '45--> "-"
    '48-57-->"0-9"
    '65-90 -->"A-Z"
    '95-->"_"
    '97-199-->"a-z"
    
    If (intASCII = 45) Or (intASCII > 47 And intASCII < 58) Or (intASCII > 64 And intASCII < 91) Or (intASCII = 95) Or (intASCII > 96 And intASCII < 123) Then
    Else
        Check_ASCII = True
    End If
    
End Function

Sub Color_Text(Optional ByVal strRange As String)

        Range(strRange).Font.ColorIndex = 3
        Range(strRange).Font.bold = True
'        Selection.Font.bold = True
    
End Sub

Sub Add_Comment(ByVal strRange As String, ByVal strMsg As String)

'    Need to delete any previous comments to prevent an error.  This will usually
'    occur when checking the ASCII character in the Category ID field.
'    Range(strRange).ClearComments
'
'    Range(strRange).AddComment
'    Range(strRange).comment.Visible = False
'    Range(strRange).comment.Text Text:=strMsg
        
End Sub

Sub Clear_Comments(ByVal strRange As String)

    Range(strRange).ClearComments
       
End Sub
Sub Reset_Font(ByVal strRange As String)

    Range(strRange).Select
    Selection.Font.ColorIndex = 0
    Selection.Font.bold = False

End Sub

Sub Unprotect_Sheet(ByVal strSheet As String)
    
    With Worksheets(strSheet)
        .Unprotect Password:="stetonadmin"
    End With

End Sub
Sub Protect_Sheet(ByVal strSheet As String)
    'Turns on the Auto Filter so it can be used when the sheet is
    'protected.
    With Worksheets(strSheet)
        .EnableAutoFilter = True
        .protect Password:="stetonadmin", DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    End With
End Sub