Common Function for getting userform information

D

Danny

Hi,

My macro has a lot of userform and multi listbox within userform (each
userform has unique name). how can I use a function to get the
selected items in different listbox?

eg.
fmMyPlot.lb_Prof_xAxis
fmMyPlot.lb_Prof_y1Axis

fmMyPlot.lb_Std_Gp
fmMyPlot.lb_Std_Series

fmMyTemplate.lb_temp1
fmMyTemplate.lb_temp2

any ideas? thx
 
P

Peter T

Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lb As MSForms.ListBox

Set lb = UserForm1.ListBox1

n = getSelected(lb, arr)

If n = -1 Then
s = "no items selected"
Else
s = arr(0)
For i = 1 To UBound(arr)
s = s & vbCr & arr(i)
Next
End If

MsgBox s

End Sub

Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = -1

ReDim arr(0 To lb.ListCount - 1)
For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
idx = idx + 1
arr(idx) = lb.List(i)
End If
Next
If idx >= 0 And idx < UBound(arr) Then
ReDim Preserve arr(0 To idx)
End If
getSelected = idx

End Function

Regards,
Peter T
 
D

Danny

Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lb As MSForms.ListBox

    Set lb = UserForm1.ListBox1

    n = getSelected(lb, arr)

    If n = -1 Then
        s = "no items selected"
    Else
        s = arr(0)
        For i = 1 To UBound(arr)
            s = s & vbCr & arr(i)
        Next
    End If

    MsgBox s

End Sub

Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

    idx = -1

    ReDim arr(0 To lb.ListCount - 1)
    For i = 0 To lb.ListCount - 1
        If lb.Selected(i) Then
            idx = idx + 1
            arr(idx) = lb.List(i)
        End If
    Next
    If idx >= 0 And idx < UBound(arr) Then
        ReDim Preserve arr(0 To idx)
    End If
    getSelected = idx

End Function

Regards,
Peter T







- Show quoted text -
Click to expand...


Hi, Thanks.

i tried to modify the second part, but failed.
mainly, the array changed from Array(x) to Array(x,2)

++++++++++++++++++
Option Base 1
Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = 0
ReDim arr(1 To lb.ListCount, 2)
For i = 1 To lb.ListCount
If lb.Selected(i - 1) = True Then
idx = idx + 1
arr(idx, 1) = lb.List(i - 1)
arr(idx, 2) = i
End If
Next
If idx >= 1 And idx < UBound(arr) Then
ReDim Preserve arr(1 To idx)
End If
getSelected = idx

End Function
++++++++++++++++++
 
R

Rick Rothstein

From the Remarks section of the help file for ReDim...

"If you use the Preserve keyword, you can resize
only the last array dimension and you can't change
the number of dimensions at all."

--
Rick (MVP - Excel)


Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lb As MSForms.ListBox

Set lb = UserForm1.ListBox1

n = getSelected(lb, arr)

If n = -1 Then
s = "no items selected"
Else
s = arr(0)
For i = 1 To UBound(arr)
s = s & vbCr & arr(i)
Next
End If

MsgBox s

End Sub

Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = -1

ReDim arr(0 To lb.ListCount - 1)
For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
idx = idx + 1
arr(idx) = lb.List(i)
End If
Next
If idx >= 0 And idx < UBound(arr) Then
ReDim Preserve arr(0 To idx)
End If
getSelected = idx

End Function

Regards,
Peter T







- Show quoted text -
Click to expand...


Hi, Thanks.

i tried to modify the second part, but failed.
mainly, the array changed from Array(x) to Array(x,2)

++++++++++++++++++
Option Base 1
Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = 0
ReDim arr(1 To lb.ListCount, 2)
For i = 1 To lb.ListCount
If lb.Selected(i - 1) = True Then
idx = idx + 1
arr(idx, 1) = lb.List(i - 1)
arr(idx, 2) = i
End If
Next
If idx >= 1 And idx < UBound(arr) Then
ReDim Preserve arr(1 To idx)
End If
getSelected = idx

End Function
++++++++++++++++++
 
D

Danny

From the Remarks section of the help file for ReDim...

"If you use the Preserve keyword, you can resize
 only the last array dimension and you can't change
 the number of dimensions at all."

--
Rick (MVP - Excel)
















Hi, Thanks.

i tried to modify the second part, but failed.
mainly, the array changed from Array(x) to Array(x,2)

++++++++++++++++++
Option Base 1
Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

    idx = 0
    ReDim arr(1 To lb.ListCount, 2)
    For i = 1 To lb.ListCount
        If lb.Selected(i - 1) = True Then
            idx = idx + 1
            arr(idx, 1) = lb.List(i - 1)
            arr(idx, 2) = i
        End If
    Next
    If idx >= 1 And idx < UBound(arr) Then
        ReDim Preserve arr(1 To idx)
    End If
    getSelected = idx

End Function
++++++++++++++++++- Hide quoted text -

- Show quoted text -
Click to expand...

Hi, Thanks.

then i will separate this set array to 2.

br,
Danny
 
P

Peter T

Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lb As MSForms.ListBox

Set lb = UserForm1.ListBox1

n = getSelected(lb, arr)

If n = -1 Then
s = "no items selected"
Else
s = arr(0)
For i = 1 To UBound(arr)
s = s & vbCr & arr(i)
Next
End If

MsgBox s

End Sub

Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = -1

ReDim arr(0 To lb.ListCount - 1)
For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
idx = idx + 1
arr(idx) = lb.List(i)
End If
Next
If idx >= 0 And idx < UBound(arr) Then
ReDim Preserve arr(0 To idx)
End If
getSelected = idx

End Function

Regards,
Peter T







- Show quoted text -
Click to expand...


Hi, Thanks.

i tried to modify the second part, but failed.
mainly, the array changed from Array(x) to Array(x,2)

++++++++++++++++++
Option Base 1
Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = 0
ReDim arr(1 To lb.ListCount, 2)
For i = 1 To lb.ListCount
If lb.Selected(i - 1) = True Then
idx = idx + 1
arr(idx, 1) = lb.List(i - 1)
arr(idx, 2) = i
End If
Next
If idx >= 1 And idx < UBound(arr) Then
ReDim Preserve arr(1 To idx)
End If
getSelected = idx

End Function
++++++++++++++++++

========================================================


As Rick says you can only Redim Preserve the last dimension. Here's same
again adapted to a get selected items from a two column multiselect Listbox

Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lbx As MSForms.ListBox

Set lbx = UserForm1.ListBox1 ' assumes 2-columns

n = getSelected(lbx, arr)

If n = -1 Then
s = "no items selected"
Else
s = arr(0, 0) & vbTab & arr(1, 0)
For i = 1 To UBound(arr, 2)
s = s & vbCr & arr(0, i) & vbTab & arr(1, i)
Next
End If

MsgBox s

End Sub

Function getSelected(lbx As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long
' to get an array of seleted items from
' a Multiselect, 2-column ListBox

idx = -1

ReDim arr(0 To 1, 0 To lbx.ListCount - 1)
For i = 0 To lbx.ListCount - 1
If lbx.Selected(i) Then
idx = idx + 1
arr(0, idx) = lbx.List(i, 0)
arr(1, idx) = lbx.List(i, 1)
End If
Next
If idx >= 0 And idx < UBound(arr) Then
ReDim Preserve arr(0 To 1, 0 To idx)
End If
getSelected = idx

End Function


This is all zero-base, adapt if you particularly want to change to one-base.

Regards,
Peter T
 
P

Peter T

Peter T said:
Hi, Thanks.

i tried to modify the second part, but failed.
mainly, the array changed from Array(x) to Array(x,2)

++++++++++++++++++
Option Base 1
Function getSelected(lb As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long

idx = 0
ReDim arr(1 To lb.ListCount, 2)
For i = 1 To lb.ListCount
If lb.Selected(i - 1) = True Then
idx = idx + 1
arr(idx, 1) = lb.List(i - 1)
arr(idx, 2) = i
End If
Next
If idx >= 1 And idx < UBound(arr) Then
ReDim Preserve arr(1 To idx)
End If
getSelected = idx

End Function
++++++++++++++++++

========================================================


As Rick says you can only Redim Preserve the last dimension. Here's same
again adapted to a get selected items from a two column multiselect
Listbox

Sub Test()
Dim i As Long, n As Long
Dim s As String
Dim arr
Dim lbx As MSForms.ListBox

Set lbx = UserForm1.ListBox1 ' assumes 2-columns

n = getSelected(lbx, arr)

If n = -1 Then
s = "no items selected"
Else
s = arr(0, 0) & vbTab & arr(1, 0)
For i = 1 To UBound(arr, 2)
s = s & vbCr & arr(0, i) & vbTab & arr(1, i)
Next
End If

MsgBox s

End Sub

Function getSelected(lbx As MSForms.ListBox, arr) As Long
Dim i As Long, idx As Long
' to get an array of seleted items from
' a Multiselect, 2-column ListBox

idx = -1

ReDim arr(0 To 1, 0 To lbx.ListCount - 1)
For i = 0 To lbx.ListCount - 1
If lbx.Selected(i) Then
idx = idx + 1
arr(0, idx) = lbx.List(i, 0)
arr(1, idx) = lbx.List(i, 1)
End If
Next
If idx >= 0 And idx < UBound(arr) Then
ReDim Preserve arr(0 To 1, 0 To idx)
End If
getSelected = idx

End Function


This is all zero-base, adapt if you particularly want to change to
one-base.

Regards,
Peter T
Click to expand...
==========================================================

Looks like I misunderstood the purpose of your 2d array, I assumed it was
because you have 2-column Listboxes. But reading again I see you have this -

arr(idx, 1) = lb.List(i - 1)
arr(idx, 2) = i

I don't know what you are attempting to do and suspect my revised demo is
not what you want.

Regards,
Peter T
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

userform list setup 1
Userform within a userform ... 7
Userform Listbox selection change 2
1 Dynamic Userform vs Multiple Userforms 2
Data Val MultiSelect on Userform? 2
Problem with Userform the second time 6
Userform listbox font color 1
Test for no listbox selection 1

Top