Excel VB help required. PLEASE?!?!?

robert_harper_2000

My form doesn't work. It doesn't enter in the unqiue customer number.

Please Help?



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

johnmc

Suggest that you take a look at the FREE forum Utter Access which is great for advanced stuff including VBA, Excel and other Office products.

rumpelstiltskin_2

The best website I have come across for Excel help (especially Excel VBA) is
http://www.ozgrid.com/forum/

Word of warning though, make sure you read their rules - strictest moderators I have ever come across !

espresso

Another Filiss

robert_harper_2000

Filiss??
thanks everyone

Willow147

It's a bit difficult to tell without seeing the spreadsheet and form.

After a quick look at the code, is it anything to do with the fact that it doesn't look like the range 'Dataset' is ever being changed, so will always return the same rowcount ?

robert_harper_2000

hmm... that seems to mean nothing to me lol would you be able to have a look if I e-mail it over to you?

Chippy_Minton

I'll have a look - I've sent you a PM.

Chippy_Minton

YHM!

I've fixed the problem with the customer id, and tidied up a few things, e.g. staff list, date and used a different method for ascertaining the last populated row (the Dataset method is a bit complicated!).

The processing for multiple pet types per customer needs some work.

Hope that helps.