' TICUA Completions data checking program
' Version: 0.1.1
' Checks Excel files for proper data formatting / values for submission to TICUA
' written in VBA for Office 2003/XP - should work fine on Office 2000
' Last update: 09-07-2006 by M. W. Albert - albert@ticua.org
'
' Please backup your data before running!
'
' This program is distributed freely, with no guarantees of any kind

Option Explicit
Dim intNumberOfRecords As Integer
' Declare variables to hold the column names containing variables we'll need
Dim strSTDTNU As String
Dim strINTNUM As String
Dim strCOMPTERM As String
Dim strFICECODE As String
Dim strCOMPYEAR As String
Dim strAWARDEDYEAR As String
Dim strAWARDEDTERM As String
Dim strDEGREELEV As String
Dim strMAJOR1 As String
Dim strMAJOR2 As String
Dim strInTELS As String
Dim strERROR As String
Dim strTELSGPA As String
Dim strCUMGPA As String
Dim strCUMHRS As String

Sub CheckFICECODE()
    ' Check to see that each student has a FICECODE value
    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strFICECODE & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing FICECODE. "
        End If
    Next intCounter
End Sub

Sub CheckCOMPTERM()
    ' Check to see that each student has a COMPTERM value and that the length of COMPTERM is 2
    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strCOMPTERM & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing COMPTERM. "
        Else
            If Range(strCOMPTERM & intCounter).Value <> "Fa" And Range(strCOMPTERM & intCounter).Value <> "Sp" And Range(strCOMPTERM & intCounter).Value <> "Su" Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "COMPTERM value is invalid. "
            End If
        End If
    Next intCounter
    
End Sub

Sub CheckCOMPYEAR()
    ' Check to see that each student has a COMPYEAR value
    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strCOMPYEAR & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing COMPYEAR. "
        Else
            If Len(Range(strCOMPYEAR & intCounter).Value) <> 4 Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "COMPYEAR value is an invalid length. "
            End If
        End If
    Next intCounter
    
End Sub

Sub CheckAWARDEDTERM()
    ' Check to see that each student has a AWARDEDTERM value and that the length of AWARDEDTERM is 2
    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strAWARDEDTERM & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing AWARDEDTERM. "
        Else
            If Range(strCOMPTERM & intCounter).Value <> "Fa" And Range(strCOMPTERM & intCounter).Value <> "Sp" And Range(strCOMPTERM & intCounter).Value <> "Su" Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "AWARDEDTERM value is invalid. "
            End If
        End If
    Next intCounter
    
End Sub

Sub CheckAWARDEDYEAR()
    ' Check to see that each student has a AWARDEDYEAR value
    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strAWARDEDYEAR & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing AWARDEDYEAR. "
        Else
            If Len(Range(strAWARDEDYEAR & intCounter).Value) <> 4 Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "AWARDEDYEAR value is an invalid length. "
            End If
        End If
    Next intCounter
    
End Sub

Sub CheckDEGREELEV()
    ' Check to see that each student has a DEGREELEV value and that it is valid
    Dim intCounter As Integer
    Worksheets("Completions").Select
    ' Check to see if blank
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strDEGREELEV & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing DEGREELEV. "
        Else
            If Range(strDEGREELEV & intCounter).Value <> "BAC" And Range(strDEGREELEV & intCounter).Value <> "MAS" And Range(strDEGREELEV & intCounter).Value <> "DOC" And Range(strDEGREELEV & intCounter).Value <> "PMC" And Range(strDEGREELEV & intCounter).Value <> "PBC" And Range(strDEGREELEV & intCounter).Value <> "FPD" And Range(strDEGREELEV & intCounter).Value <> "UGC" And Range(strDEGREELEV & intCounter).Value <> "ASO" And Range(strDEGREELEV & intCounter).Value <> "FPC" Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Invalid DEGREELEV. "
            End If
        End If
    Next intCounter
End Sub

Sub CheckMAJOR1()
    ' Check that students have a MAJOR1 and that it is numeric
    Dim intCounter As Integer
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strMAJOR1 & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing MAJOR1. "
        Else
            If IsNumeric(Range(strMAJOR1 & intCounter).Value) = False Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "MAJOR1 is non-numeric. "
            End If
        End If
    Next intCounter

End Sub



Sub CheckCUMGPA()
    ' Check that all students have a value in CUMGPA
    Dim intCounter As Integer
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
            If Range(strCUMGPA & intCounter).Value = "" Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing CUMGPA. "
            End If
    Next intCounter
End Sub

Sub CheckCUMHRS()
    ' Check that all students have a value in CUMHRS
    Dim intCounter As Integer
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
            If Range(strCUMHRS & intCounter).Value = "" Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing CUMHRS. "
            End If
    Next intCounter
End Sub

Sub CheckInTELS()
    ' Check to see that if a student has an InTELS date that it is a valid date
    Dim intCounter As Integer
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strInTELS & intCounter).Value <> "" Then
            If IsDate(Range(strInTELS & intCounter).Value) = False Then
                Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "InTELS must be a date. "
            End If
        End If
    Next intCounter
End Sub

Sub CheckTELSGPA()
    ' Check that all TELS students have a value in TELSGPA
    Dim intCounter As Integer
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
            If Range(strInTELS & intCounter).Value <> "" Then
                If Range(strTELSGPA & intCounter).Value = "" Then
                    Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing TELSGPA. "
                End If
            End If
    Next intCounter
End Sub

Sub CheckAWARDEDLESSCOMPLETED()
    ' Check that AWARDED years are greater than or equal to the COMPLETED years
    
End Sub

Sub CheckColumnNames()
' Check that the column names agree with the template
    Dim intCounter As Integer
    Dim strColumnHeadings() As Variant
    Dim intErrorCatch As Integer
    
    intErrorCatch = 0
    
    strColumnHeadings = Array("FICECODE", "INTNUM", "STDTNU", "COMPYEAR", "COMPTERM", "AWARDEDYEAR", "AWARDEDTERM", "DEGREELEV", "MAJOR1", "MAJOR2", "INTELS", "TELSGPA", "CUMGPA", "CUMHRS")
    If UCase(Range(strFICECODE & "1").Value) <> strColumnHeadings(0) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strFICECODE & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strINTNUM & "1").Value) <> strColumnHeadings(1) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strINTNUM & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strSTDTNU & "1").Value) <> strColumnHeadings(2) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strSTDTNU & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strCOMPYEAR & "1").Value) <> strColumnHeadings(3) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strCOMPYEAR & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strCOMPTERM & "1").Value) <> strColumnHeadings(4) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strCOMPTERM & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strAWARDEDYEAR & "1").Value) <> strColumnHeadings(5) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strAWARDEDYEAR & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strAWARDEDTERM & "1").Value) <> strColumnHeadings(6) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strAWARDEDTERM & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strDEGREELEV & "1").Value) <> strColumnHeadings(7) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strDEGREELEV & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strMAJOR1 & "1").Value) <> strColumnHeadings(8) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strMAJOR1 & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strMAJOR2 & "1").Value) <> strColumnHeadings(9) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strMAJOR2 & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strInTELS & "1").Value) <> strColumnHeadings(10) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strInTELS & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strTELSGPA & "1").Value) <> strColumnHeadings(11) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strTELSGPA & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strCUMGPA & "1").Value) <> strColumnHeadings(12) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strCUMGPA & ". "
         intErrorCatch = 1
    End If
    If UCase(Range(strCUMHRS & "1").Value) <> strColumnHeadings(13) Then
         Range(strERROR & "2").Value = Range(strERROR & "2").Value & "Column heading mismatch in column " & strCUMHRS & ". "
         intErrorCatch = 1
    End If
    
    If intErrorCatch = 1 Then
        MsgBox "Column heading mistmatches - aborting!", vbCritical
    End
    End If
    
End Sub


Sub RemoveApostrophes()
' Remove any cell that might have a leading apostrophe (number stored as text)
Dim MyCell As Range
Cells.Select

For Each MyCell In Selection.Cells
    If MyCell.PrefixCharacter = "'" Then
        MyCell.NumberFormat = "General"
        MyCell.Value = MyCell.Value
    End If
Next

End Sub

Sub DetermineintNumberOfRecords()
    ' Determine number of student enrollment records by evaluating several columns
    ' If all of the columns are not blank, assume the column contains a student record
    
    ' Flag to determine when to quit looping
    Dim blnFlag As Boolean
    
    blnFlag = True
    intNumberOfRecords = 2
    
    Do Until blnFlag = False
        If Range(strERROR & intNumberOfRecords).Value <> "" Or Range("B" & intNumberOfRecords).Value <> "" Or Range("C" & intNumberOfRecords).Value <> "" Or Range("D" & intNumberOfRecords).Value <> "" Or Range("E" & intNumberOfRecords).Value <> "" Then
            intNumberOfRecords = intNumberOfRecords + 1
        Else
            blnFlag = False
        End If
               
    Loop
    ' Subtract 2 to get the correct number of records, minus the heading row
    intNumberOfRecords = intNumberOfRecords - 2
End Sub

Sub InsertErrorColumn()
    ' Inserts a column titled Errors at the beginning of the Enrollment worksheet for recording errors
    ' Does not insert if a column titled Errors already exists
    Worksheets("Completions").Select
    If Range("A1").Value <> "Questions" Then
        Range("A1").Select
        Selection.EntireColumn.Insert
        Range("A1").Value = "Questions"
    End If
End Sub

Sub SetColumnVariables()
' Set the appropriate column for each variable in the report so that we can refer to it by name
 strERROR = "A"
 strFICECODE = "B"
 strINTNUM = "C"
 strSTDTNU = "D"
 strCOMPYEAR = "E"
 strCOMPTERM = "F"
 strAWARDEDYEAR = "G"
 strAWARDEDTERM = "H"
 strDEGREELEV = "I"
 strMAJOR1 = "J"
 strMAJOR2 = "K"
 strInTELS = "L"
 strTELSGPA = "M"
 strCUMGPA = "N"
 strCUMHRS = "O"
 End Sub
 
 Sub CheckSTDTNUandINTNU()
    ' For each student record, checks to see if record has at least a STDTNU or a INTNU
    ' If both are blank, records error

    Dim intCounter As Integer
    
    Worksheets("Completions").Select
    For intCounter = 2 To (intNumberOfRecords + 1)
        If Range(strSTDTNU & intCounter).Value = "" And Range(strINTNUM & intCounter).Value = "" Then
            Range(strERROR & intCounter).Value = Range(strERROR & intCounter).Value & "Missing both STDTNU and INTNUM. "
    End If
    Next intCounter
        
End Sub

Sub CheckCompletions()
    ' Initialize variable to contain number of student records
    SetColumnVariables
    intNumberOfRecords = 0
    DetermineintNumberOfRecords
    InsertErrorColumn
    CheckColumnNames
    ' Format Worksheet for ease of visual inspection
    FormatWorksheet
    FormatColumns
    CheckSTDTNUandINTNU
    CheckFICECODE
    CheckAWARDEDTERM
    CheckAWARDEDYEAR
    CheckCOMPTERM
    CheckCOMPYEAR
    CheckMAJOR1
    CheckDEGREELEV
    CheckCUMGPA
    CheckCUMHRS
    CheckTELSGPA
    MsgBox "Record Checking Completed.", vbOKOnly, "Checking Complete"
End Sub

Sub FormatWorksheet()
' With all cells, left justify, no fill color, no italic, Arial 10, autofit column width
    Cells.Select
    With Selection
        .Interior.ColorIndex = xlNone
        .Borders(xlDiagonalDown).LineStyle = xlNone
        .Borders(xlDiagonalUp).LineStyle = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
    With Selection
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Italic = False
    End With
    Cells.EntireColumn.AutoFit
End Sub

Sub FormatColumns()
    ' Format the columns correctly in case they've been changed
    Columns(strFICECODE).Select
    Selection.NumberFormat = "000000"
    Columns(strMAJOR1 & ":" & strMAJOR2).Select
    Selection.NumberFormat = "000000"
    Columns(strTELSGPA & ":" & strCUMGPA).Select
    Selection.NumberFormat = "0.00"
End Sub