data disappearing after searching and saving in Excel 2010 userform

139runner

New member
Joined
Jul 7, 2014
Messages
1
Reaction score
0
Points
0
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>
 
Hello runner,

It would seem to me that both the reading and writing of the data you are dealing with should be done in the same manner.

Have you tried writing the data from your userform to the spreadsheet the same way you load existing data into the userform rather than putting it into an array and then writing the array to the spreadsheet?




runner, have a read of this
 
You are not loosing the information on the save, you are loosing it when the existing data is loaded for the listboxes on the user form.
I never use listboxes so have no idea why.

In your CommandButtonSave_Click procedure, in the "Check user input for criteria" section, checking more than just 10 of the 27 things to be written to the spreadsheet would expose the data loss before it happens.

Good Luck with your project.
 
Do all the amending /adapting in the combobox/listbox in the userform.
When finished you can write the whole contents of the combobox/listbox to the worksheet:

Code:
Private sub Userform_initialize()
   combobox1.list=sheet1.cells(1).currentregion.Value
End Sub

Private Sub commandbuttonOK_Click()
   sheet1.cells(1).currentregion=combobox1.list
End Sub
 
Back
Top