MS Access

Option Compare Database

Private Type familyType
    familyID As Integer
    lastName As String
    firstName As String
    address1 As String
    address2 As String
    city As String
    state As String
    zipCode As String
End Type

Dim familyArray() As familyType
Dim currentArrayIndex As Integer
Dim selectedPlate As String

Private Sub btnNewFamily_Click()

    ' indicate a new family is being added, set teh user at the lastname to begin and enable the save button
    lblFamilyTitle.Caption = "New Family"
    txtLastName.SetFocus

    currentArrayIndex = 0 ' this makes the next like clear the form

    DisplayAssignedFamily

    btnNewFamily.Enabled = False
    btnSaveFamily.Enabled = True

    SetPreNextButtonState

End Sub

Private Sub btnNextFamily_Click()

    ' display the next family assigned to the plate
    currentArrayIndex = currentArrayIndex + 1
    DisplayAssignedFamily

    SetPreNextButtonState
End Sub

Private Sub btnPreviousFamily_Click()

    ' display the previous family assigned to the plate
    currentArrayIndex = currentArrayIndex - 1
    DisplayAssignedFamily

    SetPreNextButtonState

End Sub

Private Sub btnSaveFamily_Click()

    If lblFamilyTitle.Caption = "New Family" Then
        SaveNewFamilyData
    Else
        SaveEditedFamilyData
    End If

End Sub

Private Sub SaveNewFamilyData()

    Dim validateResult As String
    validateResult = ValidateFamilyData

    If Len(validateResult) > 0 Then
        MsgBox validateResult, vbExclamation, "Failed Validation"
        Exit Sub
    End If

    ' save the new family
    Dim insertSQL As String
    insertSQL = "Insert into tblFamilies (StatePlate, LastName, FirstName, Address1, Address2, City, State, ZipCode) " & _
        "Values ('" & selectedPlate & "',"

    If UBound(familyArray) = 0 Then
        ' there are no family records for this plate
        currentArrayIndex = 1

    Else
        currentArrayIndex = currentArrayIndex + 1
    End If

    ReDim Preserve familyArray(UBound(familyArray) + 1)

    ' add each value to the insert query
    Dim c As Control
    For Each c In Me.Controls
        If TypeOf c Is TextBox Then
            If c.Tag = "FamilyTextBox" Then
                c.SetFocus
                Select Case c.Name
                    Case "txtLastName"
                        insertSQL = insertSQL & "'" & Replace(c.Text, "'", "''") & "',"
                        familyArray(currentArrayIndex).lastName = c.Text

                    Case "txtFirstName"
                        insertSQL = insertSQL & "'" & Replace(c.Text, "'", "''") & "',"
                        familyArray(currentArrayIndex).firstName = c.Text

                    Case "txtAddress1"
                        insertSQL = insertSQL & "'" & Replace(c.Text, "'", "''") & "',"
                        familyArray(currentArrayIndex).address1 = c.Text

                    Case "txtAddress2"
                        insertSQL = insertSQL & "'" & Replace(c.Text, "'", "''") & "',"
                        familyArray(currentArrayIndex).address2 = c.Text

                    Case "txtCity"
                        insertSQL = insertSQL & "'" & Replace(c.Text, "'", "''") & "',"
                        familyArray(currentArrayIndex).city = c.Text

                    Case "txtState"
                        insertSQL = insertSQL & "'" & c.Text & "',"
                        familyArray(currentArrayIndex).state = c.Text

                    Case "txtZipCode"
                        insertSQL = insertSQL & "'" & c.Text & "')"
                        familyArray(currentArrayIndex).zipCode = c.Text

                End Select

            End If
        End If
    Next c

    CurrentDb.Execute insertSQL

    ' update the array with the id assigned to the family inserted into the table
    Dim rs As Recordset
    Set rs = CurrentDb.OpenRecordset("Select max(id) from tblFamilies where StatePlate='" & selectedPlate & "'", dbOpenSnapshot)
    familyArray(currentArrayIndex).familyID = rs(0)
    rs.Close

    btnSaveFamily.Enabled = False ' save is done
    btnNewFamily.Enabled = True   ' a new family can be added now

    lblFamilyTitle.Caption = "Family " & CStr(currentArrayIndex) & " of " & CStr(UBound(familyArray) - 1)

    ' fill some data for today's visit
    lblSelectedFamily.Caption = familyArray(currentArrayIndex).lastName & ", " & familyArray(currentArrayIndex).firstName
    lblVisitDateTime.Caption = Format(Now, "MM/dd/yy hh:mm:ss AM/PM")

    ' put the user in the first count field for today's visit
    Me.txtCountHispanic.SetFocus

    ' re-enable prev and next if needed
    SetPreNextButtonState

End Sub

Private Sub SaveEditedFamilyData()

    Dim validateResult As String
    validateResult = ValidateFamilyData

    If Len(validateResult) > 0 Then
        MsgBox validateResult, vbExclamation, "Failed Validation"
        Exit Sub
    End If

    ' save the pending edits
    Dim fieldName As String

    Dim c As Control
    For Each c In Me.Controls
        If TypeOf c Is TextBox Then
            If c.Tag = "FamilyTextBox" Then
                ' if even 1 textbox is marked yellow than an edit hasn't been saved
                If c.BackColor = vbYellow Then
                    Select Case c.Name
                        Case "txtLastName"
                            fieldName = "lastName"
                        Case "txtFirstName"
                            fieldName = "firstName"
                        Case "txtAddress1"
                            fieldName = "address1"
                        Case "txtAddress2"
                            fieldName = "address2"
                        Case "txtCity"
                            fieldName = "city"
                        Case "txtState"
                            fieldName = "state"
                        Case "txtZipCode"
                            fieldName = "zipCode"

                    End Select

                    SaveEditedValue c, fieldName
                    c.BackColor = vbWhite
                End If
            End If
        End If
    Next c

    btnSaveFamily.Enabled = False ' save is done
    btnNewFamily.Enabled = True   ' a new family can be added now

    ' re-enable prev and next if needed
    SetPreNextButtonState
End Sub


Private Sub SetPreNextButtonState()

    ' set the state of teh new and prev buttons
    btnPreviousFamily.Enabled = currentArrayIndex > 1 And lblFamilyTitle.Caption <> "New Family"
    btnNextFamily.Enabled = currentArrayIndex < UBound(familyArray) - 1 And lblFamilyTitle.Caption <> "New Family"

End Sub

Private Sub SaveEditedValue(txtBox As TextBox, fieldName As String)

    ' write the edit to the database - use chr(34) so that if there is an ' in the field it won't cause a query error
    txtBox.SetFocus
    CurrentDb.Execute "Update tblFamilies Set " & fieldName & "=" & Chr(34) & txtBox.Text & Chr(34) & " where id=" & familyArray(currentArrayIndex).familyID

    ' save the new value to the array as well
    Select Case txtBox.Name
        Case "txtLastName"
            familyArray(currentArrayIndex).lastName = txtBox.Text
        Case "txtFirstName"
            familyArray(currentArrayIndex).firstName = txtBox.Text
        Case "txtAddress1"
            familyArray(currentArrayIndex).address1 = txtBox.Text
        Case "txtAddress2"
            familyArray(currentArrayIndex).address2 = txtBox.Text
        Case "txtCity"
            familyArray(currentArrayIndex).city = txtBox.Text
        Case "txtState"
            familyArray(currentArrayIndex).state = txtBox.Text
        Case "txtZipCode"
            familyArray(currentArrayIndex).zipCode = txtBox.Text

    End Select

    ' check to see if the first or last name was edited, if so update the value in today's visit section
    If InStr(txtBox.Name, "name") > 0 Then lblSelectedFamily.Caption = familyArray(currentArrayIndex).lastName & ", " & familyArray(currentArrayIndex).firstName

End Sub


Private Sub btnSavePlate_Click()

    ' the plate was not found in the plates table, the user has selected to save the plate to the database
    txtPlate.SetFocus
    selectedPlate = txtPlate.Text

    If MsgBox("Are you sure you want to save the plate '" & selectedPlate & "'?", vbYesNo, "Confirm New Plate") = vbNo Then Exit Sub

    ' insert the plate number in the database
    CurrentDb.Execute "Insert Into tblPlates Values ('" & selectedPlate & "');"

    btnSavePlate.Enabled = False ' no longer needs to be enabled as the plate has been saved

    btnNewFamily_Click  ' set the user in the add new family mode

End Sub

Private Sub Form_Activate()

    txtPlate.SetFocus
    txtPlate.Text = ""

    lbMatchingPlates.Selected(0) = False

End Sub

Private Sub lbMatchingPlates_Click()

    ' exit the click event if there is nothing in the listbox
    If IsNull(lbMatchingPlates.ItemData(0)) Then Exit Sub

    ' reset the move buttons
    btnNextFamily.Enabled = False
    btnPreviousFamily.Enabled = False

    ' find the families assigned to the selected plate
    selectedPlate = lbMatchingPlates.ItemData(lbMatchingPlates.ListIndex)

    Dim familyRS As Recordset
    Set familyRS = CurrentDb.OpenRecordset("Select * from tblFamilies Where StatePlate='" & selectedPlate & "' Order by ID", dbOpenSnapshot)

    ReDim familyArray(familyRS.RecordCount + 1)

    ' if more than 1 family then display the count and enable the next record button
    If familyRS.RecordCount > 1 Then
        lblFamilyTitle.Caption = "Family 1 of " & CStr(familyRS.RecordCount)
        btnNextFamily.Enabled = True

        ' fill the array that will be used by the next and prev buttons
        Dim familyCount As Integer

        familyCount = 1
        Do While Not familyRS.EOF
            familyArray(familyCount).familyID = familyRS("ID")
            familyArray(familyCount).lastName = familyRS("lastname")
            familyArray(familyCount).firstName = familyRS("firstname")
            familyArray(familyCount).address1 = familyRS("Address1")
            familyArray(familyCount).address2 = familyRS("Address2") & ""
            familyArray(familyCount).city = familyRS("city")
            familyArray(familyCount).state = familyRS("state")
            familyArray(familyCount).zipCode = familyRS("zipcode")
            familyRS.MoveNext

            familyCount = familyCount + 1
        Loop

    Else
        lblFamilyTitle.Caption = "Family"

        familyArray(1).familyID = familyRS("ID")
        familyArray(1).lastName = familyRS("lastname")
        familyArray(1).firstName = familyRS("firstname")
        familyArray(1).address1 = familyRS("Address1")
        familyArray(1).address2 = familyRS("Address2") & ""
        familyArray(1).city = familyRS("city")
        familyArray(1).state = familyRS("state")
        familyArray(1).zipCode = familyRS("zipcode")

    End If

    familyRS.Close
    Set familyRS = Nothing

    currentArrayIndex = 1

    btnNewFamily.Enabled = True

    ' display the family record
    DisplayAssignedFamily

End Sub

Private Sub DisplayAssignedFamily()

    ' fill the controls with family data
    txtLastName.Value = familyArray(currentArrayIndex).lastName
    txtFirstName.Value = familyArray(currentArrayIndex).firstName
    txtAddress1.Value = familyArray(currentArrayIndex).address1
    txtAddress2.Value = familyArray(currentArrayIndex).address2
    txtCity.Value = familyArray(currentArrayIndex).city
    txtState.Value = familyArray(currentArrayIndex).state
    txtZipCode.Value = familyArray(currentArrayIndex).zipCode

    If currentArrayIndex > 0 Then
        ' reuse the section of the family title that has the number of families assigned to the plate
        ' but increment the number that is being viewed
        lblFamilyTitle.Caption = "Family " & CStr(currentArrayIndex) & Mid(lblFamilyTitle.Caption, InStr(lblFamilyTitle.Caption, " of"))

        ' fill some data for today's visit
        lblSelectedFamily.Caption = familyArray(currentArrayIndex).lastName & ", " & familyArray(currentArrayIndex).firstName
        lblVisitDateTime.Caption = Format(Now, "MM/dd/yy hh:mm:ss AM/PM")

        ' put the user in the first count field for today's visit
        Me.txtCountHispanic.SetFocus
    Else
        ' if the index = 0 then the family data section was reset
        lblSelectedFamily.Caption = ""
        lblVisitDateTime.Caption = ""
    End If

    SetPreNextButtonState

End Sub

Private Function ValidateFamilyData() As String

    Dim dataValidationMsg As String
    Dim minLength As Integer
    Dim maxLength As Integer

    dataValidationMsg = ""

    Dim c As Control
    For Each c In Me.Controls
        If TypeOf c Is TextBox Then
            If c.Tag = "FamilyTextBox" Then
                ' set the expected min and max length of fields to test for
                c.SetFocus
                Select Case c.Name
                    Case "txtLastName"
                        minLength = 2
                        maxLength = 50

                    Case "txtFirstName"
                        minLength = 2
                        maxLength = 50

                    Case "txtAddress1"
                        minLength = 10
                        maxLength = 150

                    Case "txtAddress2"
                        minLength = 0
                        maxLength = 150

                    Case "txtCity"
                        minLength = 3
                        maxLength = 100

                    Case "txtState"
                        minLength = 2
                        maxLength = 2

                    Case "txtZipCode"
                        minLength = 5
                        maxLength = 5

                        If Val(c.Text) = 0 Then
                            dataValidationMsg = "The Zip Code must be numeric" & vbCrLf
                        End If
                End Select

                If Len(c.Text) < minLength Or Len(c.Text) > maxLength Then
                    dataValidationMsg = dataValidationMsg & "The " & Replace(c.Name, "txt", "") & " value must be 2 characters" & vbCrLf
                End If

            End If

        End If
    Next c

    ' return any message minus the last vbCrLf
    If Len(ValidateFamilyData) > 0 Then ValidateFamilyData = Left(dataValidationMsg, Len(dataValidationMsg) - 1) Else ValidateFamilyData = ""


End Function

Private Sub handleFamilyTextChange(txtBox As TextBox)

    ' should the save button be available - because of this one change?
    ' all fields require values except for the address2 field
    ' or if the user is adding a new family to a plate there is no need to indicate an edit
    If (txtBox.Text = "" And txtBox.Name <> "txtAddress2") Or lblFamilyTitle.Caption = "New Family" Then Exit Sub

    Dim stateOfSaveButton As Boolean
    Select Case txtBox.Name
        Case "txtLastName"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).lastName

        Case "txtFirstName"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).firstName

        Case "txtAddress1"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).address1

        Case "txtAddress2"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).address2

        Case "txtCity"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).city

        Case "txtState"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).state

        Case "txtZipCode"
            stateOfSaveButton = txtBox.Text <> familyArray(currentArrayIndex).zipCode

    End Select

    ' show or remove that the field has changed and needs to be saved
    If stateOfSaveButton Then txtBox.BackColor = vbYellow Else txtBox.BackColor = vbWhite

    btnSaveFamily.Enabled = stateOfSaveButton

    If txtBox.BackColor = vbWhite Then
        ' if the box was set to white then check the other family data fields for changes needing to be saved
        Dim c As Control
        For Each c In Me.Controls
            If TypeOf c Is TextBox Then
                If c.Tag = "FamilyTextBox" Then
                    ' if even 1 textbox is colored yellow than an edit hasn't been saved
                    If c.BackColor = vbYellow Then btnSaveFamily.Enabled = True
                End If
            End If
        Next c
    End If

    ' the new, previous, or next buttons can't be enabled if there is a save pending
    btnNewFamily.Enabled = Not btnSaveFamily.Enabled
    btnPreviousFamily.Enabled = Not btnSaveFamily.Enabled
    btnNextFamily.Enabled = Not btnSaveFamily.Enabled

End Sub

Private Sub txtAddress1_Change()
    handleFamilyTextChange txtAddress1
End Sub

Private Sub txtAddress2_Change()
    handleFamilyTextChange txtAddress2
End Sub

Private Sub txtCity_Change()
    handleFamilyTextChange txtCity
End Sub

Private Sub txtFirstName_Change()
    handleFamilyTextChange txtFirstName
End Sub

Private Sub txtLastName_Change()
    handleFamilyTextChange txtLastName
End Sub

Private Sub txtState_Change()
    handleFamilyTextChange txtState
End Sub

Private Sub txtZipCode_Change()
    handleFamilyTextChange txtZipCode
End Sub

Private Sub txtPlate_Change()

    ' fill the listbox with the matching plates if there is text in the plate text box
    If Len(txtPlate.Text) > 0 Then
        lbMatchingPlates.RowSource = "SELECT tblPlates.StatePlate FROM tblPlates " & _
        "WHERE (((tblPlates.StatePlate) Like " & Chr(34) & "*" & txtPlate.Text & "*" & Chr(34) & ")) ORDER BY tblPlates.StatePlate;"

    Else
        lbMatchingPlates.RowSource = "Select top 1 '' as StatePlate from tblPlates"
    End If

    ' if there aer no matches, and there is a plate entered in the textbox, enable the "Add Plate" button
    ' to save the plate to the database
    btnSavePlate.Enabled = IIf(IsNull(lbMatchingPlates.ItemData(0)), "", lbMatchingPlates.ItemData(0)) = "" And Len(txtPlate.Text) > 0

    'btnNewFamily.Enabled = False
    'btnSaveFamily.Enabled = False

    ReDim familyArray(0)

    currentArrayIndex = 0

    DisplayAssignedFamily

End Sub