Printable View
Hi Guys,
How can i show the item from a textbox to the listbox? I want to get to item in txtdesc, txtdate,txttotal,txtapp to show in my listbox..
can someone help me on this? THanks!!
here's my code
Code:Private Sub UserForm_Initialize()
Dim MyList(10, 3) As String
Dim i As Long
MyList(0, 0) = "Description"
MyList(0, 1) = "Date"
MyList(0, 2) = "Total Claim"
MyList(0, 3) = "Approved"
For i = 1 To 10
?
?
?
ListBox1.ColumnCount = 4
ListBox1.List = MyList
End Sub
Code:ListBox1.Additem txtdesc.Text
ListBox1.Additem txtdate.Text
ListBox1.Additem txttotal.Text
ListBox1.Additem txtapp.Text
hi Hack still not wokring.. :(
I don't understand how, based on your question, it could not work.
Exactly what code are you running, and what is happening?
I dont have an error and also the items in the textbox are not apearing in the list box.. :(
Code:Private Sub txtCustNo_Change()
Dim Profile As Range
Set Profile = Sheet2.[A3:Q200]
On Error GoTo Terminate
Me.txtParent.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 1, False)
Me.txtName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 3, False)
Me.txtPhone.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 4, False)
Me.txtAddress.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 5, False)
Me.txtCity.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 6, False)
Me.txtSt.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 7, False)
Me.txtZip.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 8, False)
Me.txtContact.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 9, False)
Me.txtReqNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 10, False)
Me.txtRepNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 11, False)
Me.txtRepName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 12, False)
Me.txtClaimForm.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 13, False)
Me.txtAmt.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 14, False)
Me.txtCFDte.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 15, False)
Me.txtCFTot.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 16, False)
Me.txtCFFundsApp.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 17, False)
Terminate:
Set rngFind = Nothing
ListBox1.Additem txtdesc.Text
ListBox1.Additem txtdate.Text
ListBox1.Additem txttotal.Text
ListBox1.Additem txtapp.Text
end sub
what i want to do is when the user input the unique field which is txtcustno the items in txtdesc txtdate txttotal txtapp will will be listed ung the listbox..
try this
Code:Dim MyList(10, 3) As String
Dim i As Integer
Private Sub CommandButton1_Click()
MyList(i, 0) = txtdesc.Text
MyList(i, 1) = txtdate.Text
MyList(i, 2) = txttotal.Text
MyList(i, 3) = txtapp.Text
i = i + 1
ListBox1.List = MyList
End Sub
Private Sub UserForm_Initialize()
i = 1
MyList(0, 0) = "Description"
MyList(0, 1) = "Date"
MyList(0, 2) = "Total Claim"
MyList(0, 3) = "Approved"
ListBox1.ColumnCount = 4
ListBox1.List = MyList
End Sub
hi Kool,
its me again.. :D still not working.. in my txtcustno their are many desc, date , total and approved.. how can i display all of them in the listbox if i input the customer no..
Old habits die hard :lol:
Can you upload your file....
hi kool can u pm your personal email? i will send it thier..
done :)
Please don't forget to post any resolutions as it might help someone else.
Yes Hack,
I will post the resolution.. I dont have a winzip in my desktop here in my office so i cant compres the xls file.. I cant install any software here cause i dont have an admin rights..
@ Kool
Hi kool i've already sent the file to your emails.. :) thanks.
I don't see any
txtdesc, txtdate, txttotal, txtapp :ehh:
opps its txtclaimform, txtcfdte, txtcftot, txtamt txtcffundapp.. sorry.. :)
Ok I got it...
Double click the userform and delete all existing code and then paste the code mentioned below. I haven't checked the code for data validation in textboxes... rest it is doing what you what...
Give it a try and see if this is what you want...
I have mentioned the changes that I made at the end of the code...
Changes that I have made....Code:Dim MyList(10, 3) As String
Dim i As Integer, j As Integer
Dim Results As Integer
Private Sub CommandButton1_Click()
Call UserForm_Initialize
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton5_Click()
MyList(i, 0) = txtClaimForm.Text
MyList(i, 1) = txtCFDte.Text
MyList(i, 2) = txtCFTot.Text
MyList(i, 3) = txtCFFundsApp.Text
i = i + 1
ListBox1.List = MyList
Results = MsgBox("Are you sure you want to save this record?", vbYesNo, "")
If Results = vbYes Then
j = 3
Do While Len(Trim(Worksheets("DataSheet").Range("A" & j))) <> 0
j = j + 1
Loop
Worksheets("DataSheet").Range("A" & j) = txtCustNo.Value
Worksheets("DataSheet").Range("B" & j) = txtParent.Value
Worksheets("DataSheet").Range("C" & j) = txtName.Value
Worksheets("DataSheet").Range("D" & j) = txtPhone.Value
Worksheets("DataSheet").Range("E" & j) = txtAddress.Value
Worksheets("DataSheet").Range("F" & j) = txtCity.Value
Worksheets("DataSheet").Range("G" & j) = txtSt.Value
Worksheets("DataSheet").Range("H" & j) = txtZip.Value
Worksheets("DataSheet").Range("I" & j) = txtContact.Value
Worksheets("DataSheet").Range("J" & j) = txtReqNo.Value
Worksheets("DataSheet").Range("K" & j) = txtRepNo.Value
Worksheets("DataSheet").Range("L" & j) = txtRepName.Value
Worksheets("DataSheet").Range("M" & j) = txtClaimForm.Value
Worksheets("DataSheet").Range("N" & j) = txtAmt.Value
Worksheets("DataSheet").Range("O" & j) = txtCFDte.Value
Worksheets("DataSheet").Range("P" & j) = txtCFTot.Value
Worksheets("DataSheet").Range("Q" & j) = txtCFFundsApp.Value
End If
Call Resetdata
End Sub
Private Sub txtAmt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtcffundsapp_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtCFtot_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
'Private Sub txtCFDte_Change()
'txtCFDte.Text = Format(dd - mm - yyyy)
'End Sub
Private Sub txtCustNo_Change()
Dim Profile As Range
Set Profile = Sheet2.[A3:Q200]
On Error GoTo Terminate
Me.txtParent.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 2, False)
Me.txtName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 3, False)
Me.txtPhone.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 4, False)
Me.txtAddress.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 5, False)
Me.txtCity.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 6, False)
Me.txtSt.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 7, False)
Me.txtZip.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 8, False)
Me.txtContact.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 9, False)
Me.txtReqNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 10, False)
Me.txtRepNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 11, False)
Me.txtRepName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 12, False)
'Me.txtClaimForm.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 13, False)
'Me.txtAmt.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 14, False)
'Me.txtCFDte.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 15, False)
'Me.txtCFTot.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 16, False)
'Me.txtCFFundsApp.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 17, False)
Terminate:
Set rngFind = Nothing
End Sub
Private Sub txtPhone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtZip_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub UserForm_Initialize()
i = 1
Call Resetdata
End Sub
Sub Resetdata()
txtParent.Value = ""
txtCustNo.Value = ""
txtName.Value = ""
txtPhone.Value = ""
txtAddress.Value = ""
txtCity.Value = ""
txtSt.Value = ""
txtZip.Value = ""
txtContact.Value = ""
txtReqNo.Value = ""
txtRepNo.Value = ""
txtRepName.Value = ""
txtClaimForm.Value = ""
txtAmt.Value = ""
txtCFDte.Value = ""
txtCFTot.Value = ""
txtCFFundsApp.Value = ""
MyList(0, 0) = "Description"
MyList(0, 1) = "Date"
MyList(0, 2) = "Total Claim"
MyList(0, 3) = "Approved"
ListBox1.ColumnCount = 4
ListBox1.List = MyList
End Sub
1) declared i, j variables outside the loop
2) Change i to j so that you could save data to datasheet
3) you were storing txtParent.Value in Worksheets("DataSheet").Range("A" & j) whereas it should have been saved in Worksheets("DataSheet").Range("B" & j)
4) reset the variable of j from 5 to 3 because that is the row from where you will be checking for a blank row in datasheet...
5) A new sub for resetting the data so that I can call it at two different places...
See if it helps...
:confused: And exactly where is anything being add to a listbox?
Hack: In the CommandButton5_Click() event
Edit: @allankevin : Just one question
Why
Dim MyList(10, 3) As String
as your code won't work if you try to add 11 record in one go...
The only solution that I see here is that you will have to Redim your array if you need to allow more entries. Also a suggestion. Why don't you check with the user on how many records the user wants to insert and then exit the loop once the criteria is met???
For Example
Delete every thing in the module and paste the code mentioned below
I have modified the userform code so double click on the userform and delete all the existing code and paste this thereCode:Public inpts As String
Sub WordArt8_Click()
'CHECK FOR USER INPUTS
inpts = InputBox("Please type the number of records you want to enter")
If inpts = vbNullString Then
MsgBox "No Input, Exiting..."
Exit Sub
ElseIf Val(inpts) > 0 Then
'SHOW THE MAIN FORM
Userform1.Show
Else
MsgBox "please select a value above 0"
'RECALL THIS PROCEDURE
Call WordArt8_Click
End If
End Sub
Now try it :)Code:Dim MyList() As String
Dim i As Integer, j As Integer
Dim Results As Integer
Private Sub CommandButton1_Click()
'RESET DATA FIELDS
Call Resetdata
End Sub
Private Sub CommandButton4_Click()
Unload Me
End Sub
Private Sub CommandButton5_Click()
'STORE VALUE OF TEXTBOXES IN ARRAY
MyList(i, 0) = txtClaimForm.Text
MyList(i, 1) = txtCFDte.Text
MyList(i, 2) = txtCFTot.Text
MyList(i, 3) = txtCFFundsApp.Text
ListBox1.List = MyList
Results = MsgBox("Are you sure you want to save this record?", vbYesNo, "")
If Results = vbYes Then
'INCREASE VAL OF I
i = i + 1
'SET ROW NUMBER OF WORKSHEET
j = 3
Do While Len(Trim(Worksheets("DataSheet").Range("A" & j))) <> 0
j = j + 1
Loop
'STORE VALUES
Worksheets("DataSheet").Range("A" & j) = txtCustNo.Value
Worksheets("DataSheet").Range("B" & j) = txtParent.Value
Worksheets("DataSheet").Range("C" & j) = txtName.Value
Worksheets("DataSheet").Range("D" & j) = txtPhone.Value
Worksheets("DataSheet").Range("E" & j) = txtAddress.Value
Worksheets("DataSheet").Range("F" & j) = txtCity.Value
Worksheets("DataSheet").Range("G" & j) = txtSt.Value
Worksheets("DataSheet").Range("H" & j) = txtZip.Value
Worksheets("DataSheet").Range("I" & j) = txtContact.Value
Worksheets("DataSheet").Range("J" & j) = txtReqNo.Value
Worksheets("DataSheet").Range("K" & j) = txtRepNo.Value
Worksheets("DataSheet").Range("L" & j) = txtRepName.Value
Worksheets("DataSheet").Range("M" & j) = txtClaimForm.Value
Worksheets("DataSheet").Range("N" & j) = txtAmt.Value
Worksheets("DataSheet").Range("O" & j) = txtCFDte.Value
Worksheets("DataSheet").Range("P" & j) = txtCFTot.Value
Worksheets("DataSheet").Range("Q" & j) = txtCFFundsApp.Value
'EXIT IF THE NUMBER OF REQUIRED RECORS HAVE BEEN INPUTED
If i = Val(inpts) + 1 Then
MsgBox inpts & " Records have been added"
Unload Me
End If
End If
'RESET DATA FIELDS
Call Resetdata
End Sub
Private Sub txtAmt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtcffundsapp_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtCFtot_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
'Private Sub txtCFDte_Change()
'txtCFDte.Text = Format(dd - mm - yyyy)
'End Sub
Private Sub txtCustNo_Change()
Dim Profile As Range
Set Profile = Sheet2.[A3:Q200]
On Error GoTo Terminate
Me.txtParent.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 2, False)
Me.txtName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 3, False)
Me.txtPhone.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 4, False)
Me.txtAddress.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 5, False)
Me.txtCity.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 6, False)
Me.txtSt.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 7, False)
Me.txtZip.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 8, False)
Me.txtContact.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 9, False)
Me.txtReqNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 10, False)
Me.txtRepNo.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 11, False)
Me.txtRepName.Value = _
Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 12, False)
'Me.txtClaimForm.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 13, False)
'Me.txtAmt.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 14, False)
'Me.txtCFDte.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 15, False)
'Me.txtCFTot.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 16, False)
'Me.txtCFFundsApp.Value = _
'Application.WorksheetFunction.VLookup(txtCustNo.Value, Profile, 17, False)
Terminate:
Set rngFind = Nothing
End Sub
Private Sub txtPhone_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub txtZip_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If KeyAscii = Asc("-") Then
ElseIf KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
MsgBox "Numbers Only Pls!"
KeyAscii = 0
End If
End Sub
Private Sub UserForm_Initialize()
'REDEFINE THE ARRAY AS PER USER INPUTS
ReDim Preserve MyList(Val(inpts), 3) As String
i = 1
'RESET DATA FIELDS
Call Resetdata
End Sub
Sub Resetdata()
txtParent.Value = ""
txtCustNo.Value = ""
txtName.Value = ""
txtPhone.Value = ""
txtAddress.Value = ""
txtCity.Value = ""
txtSt.Value = ""
txtZip.Value = ""
txtContact.Value = ""
txtReqNo.Value = ""
txtRepNo.Value = ""
txtRepName.Value = ""
txtClaimForm.Value = ""
txtAmt.Value = ""
txtCFDte.Value = ""
txtCFTot.Value = ""
txtCFFundsApp.Value = ""
MyList(0, 0) = "Description"
MyList(0, 1) = "Date"
MyList(0, 2) = "Total Claim"
MyList(0, 3) = "Approved"
ListBox1.ColumnCount = 4
ListBox1.List = MyList
End Sub
Hi Kool, :)
Evrything is working fine but how can i show the items in the listbox if i input the Customer no. in txtcustno? Like searching the profile and all the Claim descriptions, Dates, Total Claims and Approved.. Because the end user wants to show all the information connected to that customer number.. thats why i use vlookup in the txtcustno_change to show the profile of the customer..but i cant figure out how to do in the listbox to show all the items listed to that customer number..
In such a case I would recommend you to create one more userform as userform2. You already have one for 'data entry'.
Create a textbox say 'txtcustno' a commandbuttion say 'cmdlookup' and a listbox 'lstdetails'
1) set the columncount of the 'lstdetails' to 17 in design mode as you have 17 headers in DATASHEET.
2) paste this code in the userform2's code
Try it...Code:Dim ar(1, 17)
Private Sub cmdlookup_Click()
'SET THE HEADERS
For i = 1 To 17
ar(0, i) = Sheets("DataSheet").Cells(2, i).Value
Next i
'SET THE ROW NUMBER
j = 3
'CHECK FOR THE CELL VALUE
Do While Trim(Worksheets("DataSheet").Range("A" & j)) <> Trim(txtcustno)
j = j + 1
Loop
'POPULATE ARRAY
For i = 1 To 17
ar(1, i) = Cells(j, i).Value
Next i
'DISPLAY ARRAY
lstdetails.List = ar
End Sub
Is this what you want?
Hi kool,
Please look at the picture.. that's what i want to do.. :)
and how can i View the list of costumers in my listbox with thesame customer numbers when i input thier customer number in the textbox?