listbox transfer to a textbox

Experts,
1) This code below isnt poulating my listbox 'fault_listbox'. I dont know why?! If fault range is in another worksheet to the current will this effect it?
With fault_listbox
    .MultiSelect = 1
    .RowSource = [FAULT_RANGE].Address
End With
2) I want the user to be able to pick mulitple values from the listbox and then hit a command button to display those selected in a textbox. They can be dragged or displayed via a commandbutton but nothing else. The user must not be able to select the same item within the listbox twice.
Could anyone help me to do this please?

Thanks

p.s i'm after some additional help for a fee to develop code -(too much foe EE)- please let me know or refer me to people who could be interested
simondopickupAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

chandru_solCommented:
Can you post your code?
simondopickupAuthor Commented:
Sure,

I want to select items from the listbox - display them in the text box and then execute the simulation. Currently the simulation finds and ignores any values from listbox that i have selected (but i cant select them because valules are not loading into the box. But when i have sorted the listbox problem out - i want to changesuch that the simulation ignores values from the textbox instead...







Private Sub UserForm_Initialize()
 
'set the user defined frame live or disable
Set wksdata = Worksheets("DATA STORE")
Set wks_week = Worksheets("OEE Weekly Summary")
Set wks_OEE = Worksheets("OEE History")
 
 
wksdata.Cells(6, 1).ClearContents
wksdata.Cells(6, 2).ClearContents
 
If wksdata.Cells(5, 3) = "RECORDING!" Then
OEE_History_frame.Enabled = True
Day_Record_Frame.Enabled = True
day_return_picker.Enabled = True
Else
OEE_History_frame.Enabled = False
Day_Record_Frame.Enabled = False
End If
 
Fault_Weekly_Toggle = False
OEE_Weekly_Toggle = False
OEE_Period_Toggle = False
Fault_Period_Toggle = False
OEE_date_start_pick.Enabled = False
OEE_date_end_pick.Enabled = False
 
'day_return_picker.Format = dtpCustom
day_return_picker.CustomFormat = Chr(32)
Analysis_Userform.Label15.Visible = False
Analysis_Userform.Label8.Caption = ""
Analysis_Userform.Label14.Caption = ""
Analysis_Userform.Label10.Caption = ""
Analysis_Userform.Label12.Caption = ""
 
Analysis_Userform.OEE_Fault_Page.Value = 0
 
With fault_listbox
    .MultiSelect = 1
    .RowSource = [FAULT_RANGE].Address<===not loading values
End With
 
Private Sub fault_listbox_click()
'no code entered yet
End Sub
Private Sub fault_listbox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
 
End Sub
' this takes a displays the faults in another textbox
Function GetSelectedItems(lstItems As MSForms.ListBox, Optional strDelimiter As String = ",") As String
   Dim lngIndex As Long, strData As String
   With lstItems
      For lngIndex = 1 To .ListCount
         If .Selected(lngIndex - 1) Then
            strData = strData & strDelimiter & lstItems.List(lngIndex - 1)
         End If
      Next lngIndex
   End With
   GetSelectedItems = Mid$(strData, Len(strDelimiter) + 1)
End Function
Private Sub fault_select_button_Click()
   Me.show_faults_textbox = GetSelectedItems(Me.fault_listbox, vbLf)
End Sub
 
Private Sub run_sim_button_Click()<==currently looks at listbox selected values. Need to change to values that have been added to the textbox...
Dim i As Long, cel As Range, ckValue As String
Dim oDic As Object
 
Set oDic = CreateObject("Scripting.Dictionary")
 
For i = 0 To fault_listbox.ListCount - 1
    If fault_listbox.Selected(i) = True Then
        ckValue = fault_listbox.List(i)
        If Not oDic.Exists(ckValue) Then
            oDic.Add ckValue, i
        End If
    End If
Next i
 
For Each cel In [FAULT_RANGE]
    ckValue = cel.Value
    If Not oDic.Exists(ckValue) Then
        ' Cell value not found in Ignore List.
        MsgBox "Process this cell/row.  Cell value = " & cel
    End If
Next cel
 
Set oDic = Nothing
 
End Sub

Open in new window

simondopickupAuthor Commented:
Can anyone help with this one!?!
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Rory ArchibaldCommented:
.RowSource = "FAULT_RANGE"

Why not just set it at design time, incidentally?
simondopickupAuthor Commented:
sorry, rorya i dont think i follow. That is only returning the first cell of the range into the textbox. At the moment. I am trying to incorporate one of *your own* solutions in the past to allow the user to drag or click on an a commandbutton to select values from the listbox (once it loads correctly) and stick them in a textbox for the user to see clearly.

Here is the code currently but i still cant load that listbox - it should have 3 values and is showing one. Should i be putting something in the click event ?

Private Sub UserForm_Initialize()
With fault_listbox
    .MultiSelect = 1
    .RowSource = "FAULT_RANGE"
End With
 
End Sub
Private Sub fault_listbox_click()
End Sub
Private Sub fault_listbox_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
End Sub
' this takes a displays the faults in another textbox
Function GetSelectedItems(lstItems As MSForms.ListBox, Optional strDelimiter As String = ",") As String
   Dim lngIndex As Long, strData As String
   With lstItems
      For lngIndex = 1 To .ListCount
         If .Selected(lngIndex - 1) Then
            strData = strData & strDelimiter & lstItems.List(lngIndex - 1)
         End If
      Next lngIndex
   End With
   GetSelectedItems = Mid$(strData, Len(strDelimiter) + 1)
End Function
Private Sub fault_select_button_Click()
   Me.show_faults_textbox = GetSelectedItems(Me.fault_listbox, vbLf)
End Sub
 
Private Sub run_sim_button_Click()
Dim i As Long, j As Long, k As Long, cel As Range, ckValue As String
Dim oDic As Object
 
Worksheets("OEE History").Visible = True
Worksheets("DATA STORE").Visible = True
 
Set oDic = CreateObject("Scripting.Dictionary")
Set wksdata = Worksheets("DATA STORE")
Set OEEwkset = Worksheets("OEE History")
 
For i = 0 To fault_listbox.ListCount - 1
    If fault_listbox.Selected(i) = True Then
        ckValue = fault_listbox.List(i)
        If Not oDic.Exists(ckValue) Then
            oDic.Add ckValue, i
        End If
    End If
Next i
 
'clear any stored selected data
wksdata.Select
With wksdata
    .Rows("9:11").ClearContents
End With
    
OEEwkset.Select
'Find the row that MTTF and MTTR data exists
Set MTTF_rw = OEEwkset.Columns(1).Find _
        ("MTTF (hrs)", OEEwkset.Cells(OEEwkset.Rows.Count, 1), xlValues, xlWhole)
        
'write new data to the data store
j = 1
k = 2
For Each cel In [FAULT_RANGE]
    ckValue = cel.Value
    If Not oDic.Exists(ckValue) Then
        wksdata.Cells(9, j) = cel.Value
        wksdata.Cells(10, j) = OEEwkset.Cells(MTTF_rw.Row, k).Value
        wksdata.Cells(11, j) = OEEwkset.Cells(MTTF_rw.Row + 1, k).Value
        j = j + 1
        ' Cell value not found in Ignore List.
        MsgBox "Process this cell/row.  Cell value = " & cel
    
    End If
    k = k + 1
Next cel
 
Set oDic = Nothing
 
Worksheets("OEE History").Visible = False
Worksheets("DATA STORE").Visible = False
 
run_sim
 
End Sub

Open in new window

Rory ArchibaldCommented:
Is FAULT_RANGE a row or column? If it's a row, you could try:

With fault_listbox
    .MultiSelect = 1
    .List = Application.Transpose([FAULT_RANGE].Value)
End With

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.