I have a complaint spreadsheet in excel 2010 with a userform for storing details of complaints received. There is a search complonent. It searches any field great. Everything seems to be working fine except for 1 little problem. When I search for a record it finds the information no problem but when I save the edited record, it loses some of the data in the fields so that when I search it again it unselects some items that are in listboxes. The specific information is under animal info (red text below). Every time I resave, it loses 1 additional piece of information until all info is unselected. This sometimes happens with "Assigned to" (in blue text) but I can't seem to find a pattern. It used to happen to the weather items (text in purple) until I changed the value to true or false instead of text strings of sun, fog, rain, snow and sleet. Any ideas why this is happening? Otherwise its a great little program.
<CODE>
Private Sub CheckBoxRain_Click()
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButtonClose_Click()
Unload Me
End Sub
Private Sub CommandButtonNew_Click()
End Sub
Private Sub CommandButtonPrint_Click()
UserForm1.PrintForm
End Sub
Private Sub CommandButtonSave_Click()
Dim RowCount As Long
Dim ctl As Control
'Check user input for criteria
If Me.ListBoxDistrict.Value = "" Then
MsgBox "Please choose a district Number!", vbExclamation, "Data"
Me.ListBoxDistrict.SetFocus
Exit Sub
End If
If Me.TextBoxName.Value = "" Then
MsgBox "Please enter the Complainant's Name!", vbExclamation, "Data"
Me.TextBoxName.SetFocus
Exit Sub
End If
If Me.TextBoxPhone.Value = "" Then
MsgBox "Please enter the Complainant's Phone number (use a hyphen)!", vbExclamation, "Data"
Me.TextBoxPhone.SetFocus
Exit Sub
End If
If Not IsNumeric(Replace(Me.TextBoxPhone.Value, "-", "")) Then
MsgBox "Enter a complainant's phone number as 111-2222!", vbExclamation, "Data"
Me.TextBoxPhone.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintDate.Value = "" Then
MsgBox "Enter a date using the format MM/DD/YYYY!", vbExclamation, "Data"
Me.TextBoxComplaintDate.SetFocus
Exit Sub
End If
If Not IsDate(Me.TextBoxComplaintDate.Value) Then
MsgBox "Date is not in the correct format, enter DD/Mm/YYYY!", vbExclamation, "Data"
Me.TextBoxComplaintDate.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintTime.Value = "" Then
MsgBox "Enter a time using 24 hour clock xx:xx!", vbExclamation, "Data"
Me.TextBoxComplaintTime.SetFocus
Exit Sub
End If
If Me.ListBoxComplaintTakenBy.Value = "" Then
MsgBox "Please select who took the complaint!", vbExclamation, "Data"
Me.ListBoxComplaintTakenBy.SetFocus
Exit Sub
End If
If Me.ListBoxRisk.Value = "" Then
MsgBox " Please select a risk level!", vbExclamation, "Data"
Me.ListBoxRisk.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintDetails.Value = "" Then
MsgBox "Please enter coimplaint details!", vbExclamation, "Data"
Me.TextBoxComplaintDetails.SetFocus
Exit Sub
End If
'Write data to worksheet
RowCount = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
If TextBoxRecordNo = "" Then
' this is a new record, go to the end
MsgBox "No record number, so this is a new record."
TextBoxRecordNo = RowCount
Else
MsgBox "I see you are editing record number " + TextBoxRecordNo + ". So we will edit the current row."
End If
'Code will take your form and put all the data into an array
arrData = Array(TextBoxRecordNo, Me.ListBoxDistrict.Value, Me.TextBoxName.Value, Me.TextBoxPhone.Value, Me.TextBoxAddress.Value, _
Me.TextBoxComplaintDate.Value, Format(Me.TextBoxComplaintTime.Value, "hh:mm"), Me.ListBoxComplaintTakenBy.Value, _
Me.ListBoxAssignedTo.Value, Me.ListBoxType.Value, Me.ListBoxRisk.Value, IIf(Me.CheckBoxSun.Value, True, False), IIf(Me.CheckBoxFog.Value, True, False), IIf(Me.CheckBoxRain.Value, True, False), _
IIf(Me.CheckBoxSnow.Value, True, False), IIf(Me.CheckBoxSleet.Value, True, False), Me.TextBoxComplaintDetails.Value, _
Me.ListBoxSpecies.Value, Me.ListBoxSex.Value, Me.ListBoxAge.Value, Me.ListBoxCondition.Value, Me.ListBoxPolice.Value, _
Me.TextBoxActionTaken.Value, Me.TextBoxActionDate.Value, Me.TextBoxActionTime.Value, Me.TextBoxGPS.Value, _
Format(Now, "mm/dd/yyyy hh:nn"))
'This will write all the data into the correct row (either the current or the last)
Worksheets("Data").Range("A" & TextBoxRecordNo).Offset(1).Resize(, UBound(arrData) + 1) = arrData
End Sub
'Search function
Private Sub CommandButtonSEARCH_Click()
Dim sFindIt As String
Dim C As Range
sFindIt = Application.InputBox(prompt:="Please enter Record No from spreadsheet:")
If sFindIt = "False" Or sFindIt = vbNullString Then Exit Sub
With Sheet1
On Error Resume Next
Set C = .Cells.Find(What:=sFindIt, After:=Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not C Is Nothing Then
'Me.TextBoxRecordNo = .Cells(lRowFnd, 7)
'Load record
Me.TextBoxRecordNo.Value = .Range("A" & C.Row)
Me.ListBoxDistrict.Value = .Range("B" & C.Row)
Me.TextBoxName.Value = .Range("C" & C.Row)
Me.TextBoxPhone.Value = .Range("D" & C.Row)
Me.TextBoxAddress.Value = .Range("E" & C.Row)
Me.TextBoxComplaintDate.Value = .Range("F" & C.Row)
Me.TextBoxComplaintTime.Value = Format(.Range("G" & C.Row), "hh:nn")
Me.ListBoxComplaintTakenBy.Value = .Range("H" & C.Row)
Me.ListBoxAssignedTo.Value = .Range("I" & C.Row)
Me.ListBoxType.Value = .Range("J" & C.Row)
Me.ListBoxRisk.Value = .Range("K" & C.Row)
Me.CheckBoxSun.Value = .Range("L" & C.Row)
Me.CheckBoxFog.Value = .Range("M" & C.Row)
Me.CheckBoxRain.Value = .Range("N" & C.Row)
Me.CheckBoxSnow.Value = .Range("O" & C.Row)
Me.CheckBoxSleet.Value = .Range("P" & C.Row)
Me.TextBoxComplaintDetails.Value = .Range("Q" & C.Row)
Me.ListBoxSpecies.Value = .Range("R" & C.Row)
Me.ListBoxSex.Value = .Range("S" & C.Row)
Me.ListBoxAge.Value = .Range("T" & C.Row)
Me.ListBoxCondition.Value = .Range("U" & C.Row)
Me.ListBoxPolice.Value = .Range("V" & C.Row)
Me.TextBoxActionTaken.Value = .Range("W" & C.Row)
Me.TextBoxActionDate.Value = .Range("X" & C.Row)
Me.TextBoxActionTime.Value = Format(.Range("Y" & C.Row), "hh:nn")
Me.TextBoxGPS.Value = .Range("Z" & C.Row)
Me.TextBoxRecordNo.Value = C.Row - 1
Else
MsgBox "Not Found"
End If
End With
ActiveWorkbook.BuiltinDocumentProperties("Author") = C.Row
End Sub
Private Sub FrameAnimalInfo_Click()
End Sub
Private Sub FrameMenu_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub LabelDate_Click()
End Sub
Private Sub ListBox4_Click()
End Sub
Private Sub LabelTimestamp_Click()
End Sub
Private Sub ListBoxAge_Click()
End Sub
Private Sub ListBoxComplaintTakenBy_Click()
End Sub
Private Sub ListBoxCondition_Click()
End Sub
Private Sub ListBoxPolice_Click()
End Sub
Private Sub ListBoxRisk_Click()
End Sub
Private Sub ListBoxSpecies_Click()
End Sub
Private Sub ListBoxType_Click()
End Sub
Private Sub TextBoxActionDate_Change()
End Sub
Private Sub TextBoxAddress_Change()
End Sub
Private Sub ListBoxDistrict_Click()
End Sub
Private Sub TextBoxComplaintDate_Change()
End Sub
Private Sub TextBoxRecordNo_Change()
End Sub
Private Sub UserForm_Click()
End Sub
<CODE>
<CODE>
Private Sub CheckBoxRain_Click()
End Sub
Private Sub CommandButton1_Click()
End Sub
Private Sub CommandButtonClose_Click()
Unload Me
End Sub
Private Sub CommandButtonNew_Click()
End Sub
Private Sub CommandButtonPrint_Click()
UserForm1.PrintForm
End Sub
Private Sub CommandButtonSave_Click()
Dim RowCount As Long
Dim ctl As Control
'Check user input for criteria
If Me.ListBoxDistrict.Value = "" Then
MsgBox "Please choose a district Number!", vbExclamation, "Data"
Me.ListBoxDistrict.SetFocus
Exit Sub
End If
If Me.TextBoxName.Value = "" Then
MsgBox "Please enter the Complainant's Name!", vbExclamation, "Data"
Me.TextBoxName.SetFocus
Exit Sub
End If
If Me.TextBoxPhone.Value = "" Then
MsgBox "Please enter the Complainant's Phone number (use a hyphen)!", vbExclamation, "Data"
Me.TextBoxPhone.SetFocus
Exit Sub
End If
If Not IsNumeric(Replace(Me.TextBoxPhone.Value, "-", "")) Then
MsgBox "Enter a complainant's phone number as 111-2222!", vbExclamation, "Data"
Me.TextBoxPhone.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintDate.Value = "" Then
MsgBox "Enter a date using the format MM/DD/YYYY!", vbExclamation, "Data"
Me.TextBoxComplaintDate.SetFocus
Exit Sub
End If
If Not IsDate(Me.TextBoxComplaintDate.Value) Then
MsgBox "Date is not in the correct format, enter DD/Mm/YYYY!", vbExclamation, "Data"
Me.TextBoxComplaintDate.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintTime.Value = "" Then
MsgBox "Enter a time using 24 hour clock xx:xx!", vbExclamation, "Data"
Me.TextBoxComplaintTime.SetFocus
Exit Sub
End If
If Me.ListBoxComplaintTakenBy.Value = "" Then
MsgBox "Please select who took the complaint!", vbExclamation, "Data"
Me.ListBoxComplaintTakenBy.SetFocus
Exit Sub
End If
If Me.ListBoxRisk.Value = "" Then
MsgBox " Please select a risk level!", vbExclamation, "Data"
Me.ListBoxRisk.SetFocus
Exit Sub
End If
If Me.TextBoxComplaintDetails.Value = "" Then
MsgBox "Please enter coimplaint details!", vbExclamation, "Data"
Me.TextBoxComplaintDetails.SetFocus
Exit Sub
End If
'Write data to worksheet
RowCount = Worksheets("Data").Range("A1").CurrentRegion.Rows.Count
If TextBoxRecordNo = "" Then
' this is a new record, go to the end
MsgBox "No record number, so this is a new record."
TextBoxRecordNo = RowCount
Else
MsgBox "I see you are editing record number " + TextBoxRecordNo + ". So we will edit the current row."
End If
'Code will take your form and put all the data into an array
arrData = Array(TextBoxRecordNo, Me.ListBoxDistrict.Value, Me.TextBoxName.Value, Me.TextBoxPhone.Value, Me.TextBoxAddress.Value, _
Me.TextBoxComplaintDate.Value, Format(Me.TextBoxComplaintTime.Value, "hh:mm"), Me.ListBoxComplaintTakenBy.Value, _
Me.ListBoxAssignedTo.Value, Me.ListBoxType.Value, Me.ListBoxRisk.Value, IIf(Me.CheckBoxSun.Value, True, False), IIf(Me.CheckBoxFog.Value, True, False), IIf(Me.CheckBoxRain.Value, True, False), _
IIf(Me.CheckBoxSnow.Value, True, False), IIf(Me.CheckBoxSleet.Value, True, False), Me.TextBoxComplaintDetails.Value, _
Me.ListBoxSpecies.Value, Me.ListBoxSex.Value, Me.ListBoxAge.Value, Me.ListBoxCondition.Value, Me.ListBoxPolice.Value, _
Me.TextBoxActionTaken.Value, Me.TextBoxActionDate.Value, Me.TextBoxActionTime.Value, Me.TextBoxGPS.Value, _
Format(Now, "mm/dd/yyyy hh:nn"))
'This will write all the data into the correct row (either the current or the last)
Worksheets("Data").Range("A" & TextBoxRecordNo).Offset(1).Resize(, UBound(arrData) + 1) = arrData
End Sub
'Search function
Private Sub CommandButtonSEARCH_Click()
Dim sFindIt As String
Dim C As Range
sFindIt = Application.InputBox(prompt:="Please enter Record No from spreadsheet:")
If sFindIt = "False" Or sFindIt = vbNullString Then Exit Sub
With Sheet1
On Error Resume Next
Set C = .Cells.Find(What:=sFindIt, After:=Cells(1, 1), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, _
SearchFormat:=False)
If Not C Is Nothing Then
'Me.TextBoxRecordNo = .Cells(lRowFnd, 7)
'Load record
Me.TextBoxRecordNo.Value = .Range("A" & C.Row)
Me.ListBoxDistrict.Value = .Range("B" & C.Row)
Me.TextBoxName.Value = .Range("C" & C.Row)
Me.TextBoxPhone.Value = .Range("D" & C.Row)
Me.TextBoxAddress.Value = .Range("E" & C.Row)
Me.TextBoxComplaintDate.Value = .Range("F" & C.Row)
Me.TextBoxComplaintTime.Value = Format(.Range("G" & C.Row), "hh:nn")
Me.ListBoxComplaintTakenBy.Value = .Range("H" & C.Row)
Me.ListBoxAssignedTo.Value = .Range("I" & C.Row)
Me.ListBoxType.Value = .Range("J" & C.Row)
Me.ListBoxRisk.Value = .Range("K" & C.Row)
Me.CheckBoxSun.Value = .Range("L" & C.Row)
Me.CheckBoxFog.Value = .Range("M" & C.Row)
Me.CheckBoxRain.Value = .Range("N" & C.Row)
Me.CheckBoxSnow.Value = .Range("O" & C.Row)
Me.CheckBoxSleet.Value = .Range("P" & C.Row)
Me.TextBoxComplaintDetails.Value = .Range("Q" & C.Row)
Me.ListBoxSpecies.Value = .Range("R" & C.Row)
Me.ListBoxSex.Value = .Range("S" & C.Row)
Me.ListBoxAge.Value = .Range("T" & C.Row)
Me.ListBoxCondition.Value = .Range("U" & C.Row)
Me.ListBoxPolice.Value = .Range("V" & C.Row)
Me.TextBoxActionTaken.Value = .Range("W" & C.Row)
Me.TextBoxActionDate.Value = .Range("X" & C.Row)
Me.TextBoxActionTime.Value = Format(.Range("Y" & C.Row), "hh:nn")
Me.TextBoxGPS.Value = .Range("Z" & C.Row)
Me.TextBoxRecordNo.Value = C.Row - 1
Else
MsgBox "Not Found"
End If
End With
ActiveWorkbook.BuiltinDocumentProperties("Author") = C.Row
End Sub
Private Sub FrameAnimalInfo_Click()
End Sub
Private Sub FrameMenu_Click()
End Sub
Private Sub Label3_Click()
End Sub
Private Sub LabelDate_Click()
End Sub
Private Sub ListBox4_Click()
End Sub
Private Sub LabelTimestamp_Click()
End Sub
Private Sub ListBoxAge_Click()
End Sub
Private Sub ListBoxComplaintTakenBy_Click()
End Sub
Private Sub ListBoxCondition_Click()
End Sub
Private Sub ListBoxPolice_Click()
End Sub
Private Sub ListBoxRisk_Click()
End Sub
Private Sub ListBoxSpecies_Click()
End Sub
Private Sub ListBoxType_Click()
End Sub
Private Sub TextBoxActionDate_Change()
End Sub
Private Sub TextBoxAddress_Change()
End Sub
Private Sub ListBoxDistrict_Click()
End Sub
Private Sub TextBoxComplaintDate_Change()
End Sub
Private Sub TextBoxRecordNo_Change()
End Sub
Private Sub UserForm_Click()
End Sub
<CODE>