[Excel]List Box VBA PROBLEM

[allankevin]

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

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

[Hack]

ListBox1.Additem txtdesc.Text
ListBox1.Additem txtdate.Text
ListBox1.Additem txttotal.Text
ListBox1.Additem txtapp.Text

[allankevin]

hi Hack still not wokring..

[Hack]

I don't understand how, based on your question, it could not work.

Exactly what code are you running, and what is happening?

[allankevin]

I dont have an error and also the items in the textbox are not apearing in the list box..

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

[allankevin]

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..

[Siddharth Rout]

try this

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

[allankevin]

hi Kool,

its me again.. 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..

[Siddharth Rout]

Old habits die hard
Can you upload your file....

[allankevin]

hi kool can u pm your personal email? i will send it thier..

[Siddharth Rout]

done

[Hack]

Please don't forget to post any resolutions as it might help someone else.

[allankevin]

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.

[Siddharth Rout]

I don't see any

txtdesc, txtdate, txttotal, txtapp

[allankevin]

opps its txtclaimform, txtcfdte, txtcftot, txtamt txtcffundapp.. sorry..

[Siddharth Rout]

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...

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

Changes that I have made....

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...

[Hack]

And exactly where is anything being add to a listbox?

[Siddharth Rout]

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???

[Siddharth Rout]

For Example

Delete every thing in the module and paste the code mentioned below

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

I have modified the userform code so double click on the userform and delete all the existing code and paste this there

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

Now try it

[allankevin]

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..

[Siddharth Rout]

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

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

Try it...

Is this what you want?

[allankevin]

Hi kool,

Please look at the picture.. that's what i want to do..

[allankevin]

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?