Pet Shop Animal Book needs repairing...

robert_harper_2000

Hello This requires Excel VB knowledge... apparently lol

I had some help from one of you guys off here (thank you) but the is a little bit of programming error... it doesn't quite work.

Would any be able to have a look? If so please pm your e-mail address and I'll e-mail it over.

Cheers, Free pet tag involved as I do all the engraving if it helps?
Cheers

Appreciate any help, quite important as we need proper database for the animals details. Also any improvements?

robert_harper_2000

Private Sub NextNumber()

'Calculates and displays the next available contact number'
txtNumber = Range("Dataset").Rows.Count

End Sub

Private Sub ClearTextBoxes()

For Each ctl In frmcontactinformation.Controls
If TypeName(ctl) = "TextBox" Then ctl.Text = ""
Next

End Sub

Private Sub cmdAdd_click_Click()

'Declare variable intNext as an integar'
Dim intNext As Integer

'Set the value of intNext to be the number of rows in Dataset'
intNext = Range("Dataset").Rows.Count + 1

'Transfer the values in the form into the spreadsheet'
Range("A" & intNext) = txtNumber.Value
Range("B" & intNext) = txtpet.Value
Range("C" & intNext) = txtqty.Value
Range("D" & intNext) = txtprice.Value
Range("E" & intNext) = txtstaff.Value
Range("F" & intNext) = Txtname.Value
Range("G" & intNext) = txtAddress.Value
Range("H" & intNext) = txtphone.Value
Range("I" & intNext) = txtdate.Value
Range("J" & intNext) = txtcomments.Value

'Runs the nextNumber procedure to display the next available number'
Call NextNumber

'clears txt boxes'
Call ClearTextBoxes

'Move the cursor to txttitle'
txtpet.SetFocus

End Sub

Private Sub frmcontactinformation_Initialize()

'Runs the NextNumber procedure'
Call NextNumber

End Sub

Private Sub Cmdanimal_Click()
' This is the 2nd Animal button click event
' It will add items to the list view
' calculating the price as it goes

Set lvwLitem = ListView1.ListItems.Add(, , txtpet)
lvwLitem.SubItems(1) = txtqty
lvwLitem.SubItems(2) = txtprice
lvwLitem.SubItems(3) = CCur(txtqty * txtprice)
ClearTxtBoxesMulti
txtpet.SetFocus
End Sub

Private Sub CommandButton1_Click()
' This is the save button at the bottom of the form
' It scans the rows, first checking that some exist
' If rows do exist they get added to the sheet

If ListView1.ListItems.Count = 0 Then Exit Sub
Dim endrow As Long

For i = 1 To ListView1.ListItems.Count
endrow = Range("Dataset").Rows.Count + 1
With Sheets("Ledger")
.Cells(endrow, 1) = endrow
.Cells(endrow, 2) = ListView1.ListItems.Item(i)
.Cells(endrow, 3) = ListView1.ListItems.Item(i).SubItems(1)
.Cells(endrow, 4) = ListView1.ListItems.Item(i).SubItems(2)
.Cells(endrow, 5) = txtstaff
.Cells(endrow, 6) = Txtname
.Cells(endrow, 7) = txtAddress
.Cells(endrow, 8) = txtphone
.Cells(endrow, 9) = txtdate
.Cells(endrow, 10) = txtcomments
End With
Next

End Sub

Private Sub CommandButton2_Click()
Unload Me

End Sub

Private Sub txtname_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Txtname = vbNullString Then Exit Sub
If IsNumeric(Txtname) Then
MsgBox "Sorry, text only"
Txtname = vbNullString
Cancel = True 'Stops them leaving with numbers in the TextBox'
End If
End Sub

Private Sub txtphone_Change()
If txtphone = vbNullString Then Exit Sub
If Not IsNumeric(txtphone) Then
MsgBox "Sorry, numbers only & no spaces"
txtphone = vbNullString
End If
End Sub

Private Sub Txtprice_Change()
If txtprice = vbNullString Then Exit Sub
If Not IsNumeric(txtprice) Then
MsgBox "Sorry, numbers only"
txtprice = vbNullString
End If
End Sub

Private Sub Txtqty_Change()
If txtqty = vbNullString Then Exit Sub
If Not IsNumeric(txtqty) Then
MsgBox "Sorry, numbers only"
txtqty = vbNullString
End If
End Sub

Private Sub UserForm_Initialize()

'Fill the list Box'
With txtstaff
.AddItem "Sarah"
.AddItem "Sammy"
.AddItem "Lisa"
.AddItem "Tasha"
.AddItem "Kirsty"
.AddItem "Dave"
.AddItem "Rob Jnr."
.AddItem "Rob Snr."
End With
'Select the first list item'
txtstaff.ListIndex = 0

'Fill the list Box'
With txtpet
.AddItem "Rodent"
.AddItem "Small Animal"
.AddItem "Bird"
.AddItem "Kitten"
End With
'Select the first list item'
txtpet.ListIndex = 0

txtdate.Text = Date
SetupListView
End Sub


Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

End Sub

Private Sub SetupListView()
' This is the listview, set some basic properties and assign the headers

Dim lvwLitem As MSComctlLib.ListItem
With ListView1
.LabelEdit = lvwManual
.View = lvwReport
.ColumnHeaders.Add , , "Pet"
.ColumnHeaders.Add , , "Quantity"
.ColumnHeaders.Add , , "Price"
.ColumnHeaders.Add , , "Total Price"
.ColumnHeaders.Item(1).Width = Me.Width / 4 - 11
.ColumnHeaders.Item(2).Width = Me.Width / 4 - 11
.ColumnHeaders.Item(3).Width = Me.Width / 4 - 11
.ColumnHeaders.Item(4).Width = Me.Width / 4 - 11
End With
End Sub


Private Sub ClearTxtBoxesMulti()
txtNumber = ""
txtpet = ""
txtqty = ""
txtprice = ""
txtcomments = ""
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then

weemee

Hi,

Your code is impressive, but your using the wrong program (by far) if your trying to create a database - infact your creating yourself unnecessary work!

Excel is not designed to carry out a database function, especially not complex ones. Your going to be bug splatting for months, the slightest error could throw the whole thing out.

You'd be better off getting a copy of Microsoft Access (or I think Openoffice do a free database system) and creating your database in a program designed for the purpose.

It'd give you less of a headache.

robert_harper_2000

Thanks but I thought about a database, however I want impressive graphs and to be able to analyse the data there will be redundant data but it won't be a big database.

Thanks for the advice!

Just got a virus now as well....... I'll post a new topic - as one prooject fixed a new one appears!!

weemee

Hello again,

Access has the ability to use the Office Charts that you use in Excel

Regards