I have a MultiSelect ListBox. I'd like to compare a VBA generated random
number with the selections in the ListBox to ensure validity. I am
currently using a loop to determine if the first item in the ListBox is
selected. If it is not selected, we move to the second item, etc. If it is
selected then we run and If...Then statement to check the random value
against the item selected in the ListBox. If the random value is not valid,
a new number must be generated by VBA. If the random number is valid, then
we check to ensure that the number has not been previously chosen (I use an
array to store the chosen numbers). If the number has not been previously
chosen, then we move on with life. If the number has already been chosen
then VBA must select another random number then we must start the process
over again to ensure that the new selected number is first valid against the
selected items in the ListBox then checking again for a duplicate value.

I was fine when I had a simple program to simply check for duplicate values.
VBA selected the number then I used a separate function to check for a
duplicate value. My problem started when I threw in the ListBox selection
section. I can't seem to come up with a fluid method of doing what I
described above. I can probably come up with the programming if someone can
help with the logic.

TIA
Mike.



--
Michael J. Malinsky

Mike

Something like this?

Sub test()

Dim lb As msforms.ListBox
Dim NewNum As Long
Dim i As Long
Dim UsedNums() As Long

Set lb = Sheet1.ListBox1
ReDim UsedNums(0)

For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
Do
NewNum = GetRand
Loop Until CheckNum(NewNum) And NoDups(NewNum, UsedNums)
UsedNums(UBound(UsedNums)) = NewNum
If i < lb.ListCount - 1 Then
ReDim Preserve UsedNums(UBound(UsedNums) + 1)
End If
End If
Next i

For i = LBound(UsedNums) To UBound(UsedNums)
Debug.Print UsedNums(i)
Next i

End Sub

Function GetRand() As Long

Randomize

GetRand = Int(Rnd * 4) + 1

End Function

Function CheckNum(Num As Long) As Boolean

CheckNum = (Num <= 2 And Num 0)

End Function

Function NoDups(Num As Long, DupNums As Variant) As Boolean

Dim i As Long

NoDups = True

For i = LBound(DupNums) To UBound(DupNums)
If DupNums(i) = Num Then
NoDups = False
Exit For
End If
Next i

End Function

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Michael J. Malinsky" wrote in message
...
I have a MultiSelect ListBox. I'd like to compare a VBA generated random
number with the selections in the ListBox to ensure validity. I am
currently using a loop to determine if the first item in the ListBox is
selected. If it is not selected, we move to the second item, etc. If it
is
selected then we run and If...Then statement to check the random value
against the item selected in the ListBox. If the random value is not
valid,
a new number must be generated by VBA. If the random number is valid,
then
we check to ensure that the number has not been previously chosen (I use
an
array to store the chosen numbers). If the number has not been previously
chosen, then we move on with life. If the number has already been chosen
then VBA must select another random number then we must start the process
over again to ensure that the new selected number is first valid against
the
selected items in the ListBox then checking again for a duplicate value.

I was fine when I had a simple program to simply check for duplicate
values.
VBA selected the number then I used a separate function to check for a
duplicate value. My problem started when I threw in the ListBox selection
section. I can't seem to come up with a fluid method of doing what I
described above. I can probably come up with the programming if someone
can
help with the logic.

TIA
Mike.



--
Michael J. Malinsky

Dick,

Thanks for the suggestion, but your Do...Loop routine didn't seem to
fit my needs. I needed the number checked (CheckNum) for validity
then I needed to check for a duplicate (NoDups). However, if NoDups
found a duplicate, then I needed CheckNum to run again. I thought I
modified your code to meet my needs, but I couldn't get it to work. I
did, however, come up with a methodology that does work. I set
num_flag to 0 and dup_flag to 0. I then replaced:

Loop Until CheckNum(NewNum) And NoDups(NewNum, UsedNums)

with

Loop Until num_flag = 1 and dup_flag = 1

I then modified my functions to read as follows:

Function Days_Check(RandomNumber, y, BeginDate, Population)

Beginning:
For x = 0 To lbDays.ListCount - 1
If lbDays.Selected(x) = True Then
If lbDays.List(x) = WeekdayName(Weekday(RandomNumber(y) +
BeginDate - 1)) Then
days_flag = 1
End If
End If
Next x
If days_flag < 1 Then
RandomNumber(y) = Int(Population * Rnd + 1)
dup_flag = 0
GoTo Beginning
End If

End Function

Function Duplicate_Check(RandomNumber, y, Population)

'Loops through all previously selected numbers to determine if
duplicates have been chosen

Dim z As Integer

Beginning:
For z = 0 To y - 1
If RandomNumber(z) = RandomNumber(y) Then
RandomNumber(y) = Int(Population * Rnd + 1)
days_flag = 0
GoTo Beginning
End If
Next z
dup_flag = 1

End Function

So now the selection of the random number runs until both flags equal
1.

It works, which makes me happy. My question is whether or not your
method should have worked to meet my needs. I've never seen functions
called from a Do...Loop (or from anywhere other than a Call function)
so I'm not sure if it should have done what I wanted or not. At any
rate, your suggestion helped me ferret out an answer and for that I am
grateful.

Thanks much.

Mike.

"Dick Kusleika" wrote in message ...
Mike

Something like this?

Sub test()

Dim lb As msforms.ListBox
Dim NewNum As Long
Dim i As Long
Dim UsedNums() As Long

Set lb = Sheet1.ListBox1
ReDim UsedNums(0)

For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
Do
NewNum = GetRand
Loop Until CheckNum(NewNum) And NoDups(NewNum, UsedNums)
UsedNums(UBound(UsedNums)) = NewNum
If i < lb.ListCount - 1 Then
ReDim Preserve UsedNums(UBound(UsedNums) + 1)
End If
End If
Next i

For i = LBound(UsedNums) To UBound(UsedNums)
Debug.Print UsedNums(i)
Next i

End Sub

Function GetRand() As Long

Randomize

GetRand = Int(Rnd * 4) + 1

End Function

Function CheckNum(Num As Long) As Boolean

CheckNum = (Num <= 2 And Num 0)

End Function

Function NoDups(Num As Long, DupNums As Variant) As Boolean

Dim i As Long

NoDups = True

For i = LBound(DupNums) To UBound(DupNums)
If DupNums(i) = Num Then
NoDups = False
Exit For
End If
Next i

End Function

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Michael J. Malinsky" wrote in message
...
I have a MultiSelect ListBox. I'd like to compare a VBA generated random
number with the selections in the ListBox to ensure validity. I am
currently using a loop to determine if the first item in the ListBox is
selected. If it is not selected, we move to the second item, etc. If it
is
selected then we run and If...Then statement to check the random value
against the item selected in the ListBox. If the random value is not
valid,
a new number must be generated by VBA. If the random number is valid,
then
we check to ensure that the number has not been previously chosen (I use
an
array to store the chosen numbers). If the number has not been previously
chosen, then we move on with life. If the number has already been chosen
then VBA must select another random number then we must start the process
over again to ensure that the new selected number is first valid against
the
selected items in the ListBox then checking again for a duplicate value.

I was fine when I had a simple program to simply check for duplicate
values.
VBA selected the number then I used a separate function to check for a
duplicate value. My problem started when I threw in the ListBox selection
section. I can't seem to come up with a fluid method of doing what I
described above. I can probably come up with the programming if someone
can
help with the logic.

TIA
Mike.



--
Michael J. Malinsky

Mike

It could be that I don't fully understand what you are trying to achieve.
It seems that my method would work, but we are definitely approaching this
from different angles.

With your functions, it seems that you are creating a random number for each
item selected in a listbox and checking the validity of that number. Once
you have a valid number for each selection, you then check to see if there
are any duplicates. If a duplicate is found, you replace that number with a
new random number, but you don't seem to ever check the validity of THAT
number.

With mine, each function is called for each selection in the listbox. If
the number is either invalid or a duplicate, then it generates a new number
before it ever goes to the next selected item. This ensures that every
random number is both valid and unique for each selected item. Whereas your
loop does the whole population of random numbers for each loop, mine does
one number at a time.

Unless I'm missing something, it seems that you have a logic error in there
(namely, that you could replace a duplicate with an invalid number) and mine
should run way faster. Also, I (almost) never use GOTOs and public
variables.

If you want to sort this out for all time, then post your whole code or send
me a sample privately. Be sure to explain what your variables are and what
you are checking as far as validity. If you're happy with the way it is and
don't want to persue it, I understand that.

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Michael Malinsky" wrote in message
om...
Dick,

Thanks for the suggestion, but your Do...Loop routine didn't seem to
fit my needs. I needed the number checked (CheckNum) for validity
then I needed to check for a duplicate (NoDups). However, if NoDups
found a duplicate, then I needed CheckNum to run again. I thought I
modified your code to meet my needs, but I couldn't get it to work. I
did, however, come up with a methodology that does work. I set
num_flag to 0 and dup_flag to 0. I then replaced:

Loop Until CheckNum(NewNum) And NoDups(NewNum, UsedNums)

with

Loop Until num_flag = 1 and dup_flag = 1

I then modified my functions to read as follows:

Function Days_Check(RandomNumber, y, BeginDate, Population)

Beginning:
For x = 0 To lbDays.ListCount - 1
If lbDays.Selected(x) = True Then
If lbDays.List(x) = WeekdayName(Weekday(RandomNumber(y) +
BeginDate - 1)) Then
days_flag = 1
End If
End If
Next x
If days_flag < 1 Then
RandomNumber(y) = Int(Population * Rnd + 1)
dup_flag = 0
GoTo Beginning
End If

End Function

Function Duplicate_Check(RandomNumber, y, Population)

'Loops through all previously selected numbers to determine if
duplicates have been chosen

Dim z As Integer

Beginning:
For z = 0 To y - 1
If RandomNumber(z) = RandomNumber(y) Then
RandomNumber(y) = Int(Population * Rnd + 1)
days_flag = 0
GoTo Beginning
End If
Next z
dup_flag = 1

End Function

So now the selection of the random number runs until both flags equal
1.

It works, which makes me happy. My question is whether or not your
method should have worked to meet my needs. I've never seen functions
called from a Do...Loop (or from anywhere other than a Call function)
so I'm not sure if it should have done what I wanted or not. At any
rate, your suggestion helped me ferret out an answer and for that I am
grateful.

Thanks much.

Mike.

"Dick Kusleika" wrote in message
...
Mike

Something like this?

Sub test()

Dim lb As msforms.ListBox
Dim NewNum As Long
Dim i As Long
Dim UsedNums() As Long

Set lb = Sheet1.ListBox1
ReDim UsedNums(0)

For i = 0 To lb.ListCount - 1
If lb.Selected(i) Then
Do
NewNum = GetRand
Loop Until CheckNum(NewNum) And NoDups(NewNum, UsedNums)
UsedNums(UBound(UsedNums)) = NewNum
If i < lb.ListCount - 1 Then
ReDim Preserve UsedNums(UBound(UsedNums) + 1)
End If
End If
Next i

For i = LBound(UsedNums) To UBound(UsedNums)
Debug.Print UsedNums(i)
Next i

End Sub

Function GetRand() As Long

Randomize

GetRand = Int(Rnd * 4) + 1

End Function

Function CheckNum(Num As Long) As Boolean

CheckNum = (Num <= 2 And Num 0)

End Function

Function NoDups(Num As Long, DupNums As Variant) As Boolean

Dim i As Long

NoDups = True

For i = LBound(DupNums) To UBound(DupNums)
If DupNums(i) = Num Then
NoDups = False
Exit For
End If
Next i

End Function

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Michael J. Malinsky" wrote in message
...
I have a MultiSelect ListBox. I'd like to compare a VBA generated
random
number with the selections in the ListBox to ensure validity. I am
currently using a loop to determine if the first item in the ListBox
is
selected. If it is not selected, we move to the second item, etc. If
it
is
selected then we run and If...Then statement to check the random value
against the item selected in the ListBox. If the random value is not
valid,
a new number must be generated by VBA. If the random number is valid,
then
we check to ensure that the number has not been previously chosen (I
use
an
array to store the chosen numbers). If the number has not been
previously
chosen, then we move on with life. If the number has already been
chosen
then VBA must select another random number then we must start the
process
over again to ensure that the new selected number is first valid
against
the
selected items in the ListBox then checking again for a duplicate
value.

I was fine when I had a simple program to simply check for duplicate
values.
VBA selected the number then I used a separate function to check for a
duplicate value. My problem started when I threw in the ListBox
selection
section. I can't seem to come up with a fluid method of doing what I
described above. I can probably come up with the programming if
someone
can
help with the logic.

TIA
Mike.



--
Michael J. Malinsky