B
Binaface
Hello there,
I am trying to creat an Update/Delete form for a livestock inventory
database for a ranch in northern CA. I have the coding as follows, but I keep
getting an unspecified error that highlights my ".Clear" in tbe Private Sub
LoadData() section. Would anyone have any suggestions on how to get past
this? The coding for the entire form is copied below. Thank you!!
CODE:
Option Explicit
Private Source As Range
Private Index As Long
Private animals As String
Private Sub btnUpdate_Click()
Dim pointer As String
If Animal_ID_tb.Text = "" Then Exit Sub
If Trim(Me.Date_Entered_tb.Value) = "" Then Exit Sub
If Trim(Me.Sex_tb.Text) = "" Then Exit Sub
If Trim(Me.birth_weight_tb.Value) = "" Then Exit Sub
If Trim(Me.ParceL_Number_tb.Value) = "" Then Exit Sub
If Trim(Me.weaning_weight_tb.Value) = "" Then Exit Sub
If Trim(Me.Index_tb.Value) = "" Then Exit Sub
If Trim(Me.Breed_tb.Value) = "" Then Exit Sub
If Trim(Me.DOB_tb.Value) = "" Then Exit Sub
If Not IsNumeric(Me.Animal_ID_tb.Text) Then Exit Sub ' what does this mean?
pointer = lstData.ListIndex
For Index = 1 To Source.Rows.Count
If Source.Cells(Index, 1) = Trim(Me.Type_cmb.Value) Then
Source.Cells(Index, 2) = Trim(Me.Date_Entered_tb.Value)
Source.Cells(Index, 3) = Trim(Me.Index_tb.Value)
Source.Cells(Index, 4) = Trim(Me.Animal_ID_tb.Value)
Source.Cells(Index, 5) = Trim(Me.DOB_tb.Value)
Source.Cells(Index, 6) = Trim(Me.ParceL_Number_tb.Value)
Source.Cells(Index, 7) = Trim(Me.Sire_ID_tb.Value)
Source.Cells(Index, 8) = Trim(Me.Dam_ID_tb.Value)
Source.Cells(Index, 9) = Trim(Me.Sex_tb.Value)
Source.Cells(Index, 10) = Trim(Me.Age_of_Dam_tb.Value)
Source.Cells(Index, 11) = Trim(Me.dam_weight_tb.Value)
Source.Cells(Index, 12) = Trim(Me.Breed_tb.Value)
Source.Cells(Index, 13) = Trim(Me.birth_weight_tb.Value)
Source.Cells(Index, 14) = Trim(Me.weaning_weight_tb.Value)
Exit For
End If
Next
LoadData
lstData.ListIndex = pointer
End Sub
Private Sub Type_cmb_change()
LoadData
End Sub
Private Sub cmdDelete_click()
If lstData.ListIndex = -1 Then Exit Sub
Dim Index As String
Dim msg As String
Index = Me.Type_cmb.Value
msg = msg & "" & lstData.List(lstData.ListIndex, 1)
msg = msg & "" & lstData.List(lstData.ListIndex, 2)
msg = msg & "" & lstData.List(lstData.ListIndex, 3)
msg = msg & "" & lstData.List(lstData.ListIndex, 4)
msg = msg & "" & lstData.List(lstData.ListIndex, 5)
msg = msg & "" & lstData.List(lstData.ListIndex, 6)
msg = msg & "" & lstData.List(lstData.ListIndex, 7)
msg = msg & "" & lstData.List(lstData.ListIndex, 8)
msg = msg & "" & lstData.List(lstData.ListIndex, 9)
msg = msg & "" & lstData.List(lstData.ListIndex, 10)
msg = msg & "" & lstData.List(lstData.ListIndex, 11)
msg = msg & "" & lstData.List(lstData.ListIndex, 12)
msg = msg & "" & lstData.List(lstData.ListIndex, 13)
msg = msg & "" & lstData.List(lstData.ListIndex, 14)
If MsgBox(msg, vbYesNo + vbDefaultButton2, "DELETE #" & Index & "from" &
Type_cmb) = vbYes Then
RemoveItem Index
End If
End Sub
Private Sub RemoveItem(Index As String)
Dim found As Range
Dim OK As Boolean
With Worksheets("Manual Livestock Data")
For Each found In .Range(.Range("A7"), .Range("A7").End(xlDown))
If found = Index Then
OK = True
Exit For
End If
Next
End With
If OK Then
found.Resize(, 6).Delete xlShiftUp
LoadData
Else
MsgBox Index & "Not found!"
End If
End Sub
Private Sub lstdata_click()
With lstData
Me.Type_cmb.Value = .List(.ListIndex, 1)
Me.Date_Entered_tb.Value = .List(.ListIndex, 2)
Me.Index_tb.Value = .List(.ListIndex, 3)
Me.Animal_ID_tb.Value = .List(.ListIndex, 4)
Me.DOB_tb.Value = .List(.ListIndex, 5)
Me.ParceL_Number_tb.Value = .List(.ListIndex, 6)
Me.Sire_ID_tb.Value = .List(.ListIndex, 7)
Me.Dam_ID_tb.Value = .List(.ListIndex, 8)
Me.Sex_tb.Value = .List(.ListIndex, 9)
Me.Age_of_Dam_tb.Value = .List(.ListIndex, 10)
Me.dam_weight_tb.Value = .List(.ListIndex, 11)
Me.Breed_tb.Value = .List(.ListIndex, 12)
Me.birth_weight_tb.Value = .List(.ListIndex, 13)
Me.weaning_weight_tb.Value = .List(.ListIndex, 14)
End With
End Sub
Private Sub UserForm_Initialize()
With Worksheets("Manual Livestock Data")
Set Source = .Range(Range("A7"), .Range("N7").End(xlDown))
End With
LoadAnimals
End Sub
Private Sub LoadAnimals()
Dim animal As New Scripting.Dictionary
For Index = 1 To Source.Rows.Count
animals = Source.Cells(Index, "A").Value
If Not animal.Exists(animals) Then
animal.Add animals, animals
Type_cmb.AddItem animals
End If
Next
End Sub
Private Sub LoadData()
Me.Type_cmb = ""
Me.Sex_tb = ""
Me.Sire_ID_tb = ""
Me.birth_weight_tb = ""
Me.ParceL_Number_tb = ""
Me.Date_Entered_tb = ""
Me.Dam_ID_tb = ""
Me.weaning_weight_tb = ""
Me.Animal_ID_tb = ""
Me.Index_tb = ""
Me.Age_of_Dam_tb = ""
Me.Breed_tb = ""
Me.DOB_tb = ""
Me.dam_weight_tb = ""
With lstData
..Clear 'HERE IS THE LOCATION OF THE MAIN ERROR
animals = Me.Type_cmb.Value
For Index = 1 To Source.Rows.Count
If animals = Source.Cells(Index, 1) Then
..AddItem Source.Cells(Index, 1)
..List(.ListCount - 1, 1) = Source.Cells(Index, 1)
..List(.ListCount - 1, 2) = Source.Cells(Index, 2)
..List(.ListCount - 1, 3) = Source.Cells(Index, 3)
..List(.ListCount - 1, 4) = Source.Cells(Index, 4)
..List(.ListCount - 1, 5) = Source.Cells(Index, 5)
..List(.ListCount - 1, 6) = Source.Cells(Index, 6)
..List(.ListCount - 1, 7) = Source.Cells(Index, 7)
..List(.ListCount - 1, 8) = Source.Cells(Index, 8)
..List(.ListCount - 1, 9) = Source.Cells(Index, 9)
..List(.ListCount - 1, 10) = Source.Cells(Index, 10)
..List(.ListCount - 1, 11) = Source.Cells(Index, 11)
..List(.ListCount - 1, 12) = Source.Cells(Index, 12)
..List(.ListCount - 1, 13) = Source.Cells(Index, 13)
..List(.ListCount - 1, 14) = Source.Cells(Index, 14)
End If
Next
End With
End Sub
I am trying to creat an Update/Delete form for a livestock inventory
database for a ranch in northern CA. I have the coding as follows, but I keep
getting an unspecified error that highlights my ".Clear" in tbe Private Sub
LoadData() section. Would anyone have any suggestions on how to get past
this? The coding for the entire form is copied below. Thank you!!
CODE:
Option Explicit
Private Source As Range
Private Index As Long
Private animals As String
Private Sub btnUpdate_Click()
Dim pointer As String
If Animal_ID_tb.Text = "" Then Exit Sub
If Trim(Me.Date_Entered_tb.Value) = "" Then Exit Sub
If Trim(Me.Sex_tb.Text) = "" Then Exit Sub
If Trim(Me.birth_weight_tb.Value) = "" Then Exit Sub
If Trim(Me.ParceL_Number_tb.Value) = "" Then Exit Sub
If Trim(Me.weaning_weight_tb.Value) = "" Then Exit Sub
If Trim(Me.Index_tb.Value) = "" Then Exit Sub
If Trim(Me.Breed_tb.Value) = "" Then Exit Sub
If Trim(Me.DOB_tb.Value) = "" Then Exit Sub
If Not IsNumeric(Me.Animal_ID_tb.Text) Then Exit Sub ' what does this mean?
pointer = lstData.ListIndex
For Index = 1 To Source.Rows.Count
If Source.Cells(Index, 1) = Trim(Me.Type_cmb.Value) Then
Source.Cells(Index, 2) = Trim(Me.Date_Entered_tb.Value)
Source.Cells(Index, 3) = Trim(Me.Index_tb.Value)
Source.Cells(Index, 4) = Trim(Me.Animal_ID_tb.Value)
Source.Cells(Index, 5) = Trim(Me.DOB_tb.Value)
Source.Cells(Index, 6) = Trim(Me.ParceL_Number_tb.Value)
Source.Cells(Index, 7) = Trim(Me.Sire_ID_tb.Value)
Source.Cells(Index, 8) = Trim(Me.Dam_ID_tb.Value)
Source.Cells(Index, 9) = Trim(Me.Sex_tb.Value)
Source.Cells(Index, 10) = Trim(Me.Age_of_Dam_tb.Value)
Source.Cells(Index, 11) = Trim(Me.dam_weight_tb.Value)
Source.Cells(Index, 12) = Trim(Me.Breed_tb.Value)
Source.Cells(Index, 13) = Trim(Me.birth_weight_tb.Value)
Source.Cells(Index, 14) = Trim(Me.weaning_weight_tb.Value)
Exit For
End If
Next
LoadData
lstData.ListIndex = pointer
End Sub
Private Sub Type_cmb_change()
LoadData
End Sub
Private Sub cmdDelete_click()
If lstData.ListIndex = -1 Then Exit Sub
Dim Index As String
Dim msg As String
Index = Me.Type_cmb.Value
msg = msg & "" & lstData.List(lstData.ListIndex, 1)
msg = msg & "" & lstData.List(lstData.ListIndex, 2)
msg = msg & "" & lstData.List(lstData.ListIndex, 3)
msg = msg & "" & lstData.List(lstData.ListIndex, 4)
msg = msg & "" & lstData.List(lstData.ListIndex, 5)
msg = msg & "" & lstData.List(lstData.ListIndex, 6)
msg = msg & "" & lstData.List(lstData.ListIndex, 7)
msg = msg & "" & lstData.List(lstData.ListIndex, 8)
msg = msg & "" & lstData.List(lstData.ListIndex, 9)
msg = msg & "" & lstData.List(lstData.ListIndex, 10)
msg = msg & "" & lstData.List(lstData.ListIndex, 11)
msg = msg & "" & lstData.List(lstData.ListIndex, 12)
msg = msg & "" & lstData.List(lstData.ListIndex, 13)
msg = msg & "" & lstData.List(lstData.ListIndex, 14)
If MsgBox(msg, vbYesNo + vbDefaultButton2, "DELETE #" & Index & "from" &
Type_cmb) = vbYes Then
RemoveItem Index
End If
End Sub
Private Sub RemoveItem(Index As String)
Dim found As Range
Dim OK As Boolean
With Worksheets("Manual Livestock Data")
For Each found In .Range(.Range("A7"), .Range("A7").End(xlDown))
If found = Index Then
OK = True
Exit For
End If
Next
End With
If OK Then
found.Resize(, 6).Delete xlShiftUp
LoadData
Else
MsgBox Index & "Not found!"
End If
End Sub
Private Sub lstdata_click()
With lstData
Me.Type_cmb.Value = .List(.ListIndex, 1)
Me.Date_Entered_tb.Value = .List(.ListIndex, 2)
Me.Index_tb.Value = .List(.ListIndex, 3)
Me.Animal_ID_tb.Value = .List(.ListIndex, 4)
Me.DOB_tb.Value = .List(.ListIndex, 5)
Me.ParceL_Number_tb.Value = .List(.ListIndex, 6)
Me.Sire_ID_tb.Value = .List(.ListIndex, 7)
Me.Dam_ID_tb.Value = .List(.ListIndex, 8)
Me.Sex_tb.Value = .List(.ListIndex, 9)
Me.Age_of_Dam_tb.Value = .List(.ListIndex, 10)
Me.dam_weight_tb.Value = .List(.ListIndex, 11)
Me.Breed_tb.Value = .List(.ListIndex, 12)
Me.birth_weight_tb.Value = .List(.ListIndex, 13)
Me.weaning_weight_tb.Value = .List(.ListIndex, 14)
End With
End Sub
Private Sub UserForm_Initialize()
With Worksheets("Manual Livestock Data")
Set Source = .Range(Range("A7"), .Range("N7").End(xlDown))
End With
LoadAnimals
End Sub
Private Sub LoadAnimals()
Dim animal As New Scripting.Dictionary
For Index = 1 To Source.Rows.Count
animals = Source.Cells(Index, "A").Value
If Not animal.Exists(animals) Then
animal.Add animals, animals
Type_cmb.AddItem animals
End If
Next
End Sub
Private Sub LoadData()
Me.Type_cmb = ""
Me.Sex_tb = ""
Me.Sire_ID_tb = ""
Me.birth_weight_tb = ""
Me.ParceL_Number_tb = ""
Me.Date_Entered_tb = ""
Me.Dam_ID_tb = ""
Me.weaning_weight_tb = ""
Me.Animal_ID_tb = ""
Me.Index_tb = ""
Me.Age_of_Dam_tb = ""
Me.Breed_tb = ""
Me.DOB_tb = ""
Me.dam_weight_tb = ""
With lstData
..Clear 'HERE IS THE LOCATION OF THE MAIN ERROR
animals = Me.Type_cmb.Value
For Index = 1 To Source.Rows.Count
If animals = Source.Cells(Index, 1) Then
..AddItem Source.Cells(Index, 1)
..List(.ListCount - 1, 1) = Source.Cells(Index, 1)
..List(.ListCount - 1, 2) = Source.Cells(Index, 2)
..List(.ListCount - 1, 3) = Source.Cells(Index, 3)
..List(.ListCount - 1, 4) = Source.Cells(Index, 4)
..List(.ListCount - 1, 5) = Source.Cells(Index, 5)
..List(.ListCount - 1, 6) = Source.Cells(Index, 6)
..List(.ListCount - 1, 7) = Source.Cells(Index, 7)
..List(.ListCount - 1, 8) = Source.Cells(Index, 8)
..List(.ListCount - 1, 9) = Source.Cells(Index, 9)
..List(.ListCount - 1, 10) = Source.Cells(Index, 10)
..List(.ListCount - 1, 11) = Source.Cells(Index, 11)
..List(.ListCount - 1, 12) = Source.Cells(Index, 12)
..List(.ListCount - 1, 13) = Source.Cells(Index, 13)
..List(.ListCount - 1, 14) = Source.Cells(Index, 14)
End If
Next
End With
End Sub