VBA - Unique, Random Numbers From A List

S

StuFromSaturday

Board Regular
Joined
Nov 3, 2009
Messages
81
Afternoon all

I have scoured this site and read countless threads but I am still not coming up with the goods so I'm hoping someone can help me out...

I have a long list of numbers in Column E, which varies in length from time to time but will always start at E8. I need to:

a) Extract (say) 10 unique numbers from this list, and pop them in H8:H17, and then

b) Extract (say) 3 unique numbers from that list of 10, and pop them in K8:K10.

I've copied countless examples from this site over and run them, however they just don't seem to work once I get to the list of 3 - I get duplicates.

Is there a simple method I'm missing here??

Any and all help greatly appreciated.


Stu
 
Sort by date Sort by votes
Hi Eric, sorry to ask this but I wonder if I might trouble you again for some help?

First of all, I've made a couple of additions; input boxes to allow the user to define the size of both lists, and an option for market cap/equal weighted - I wonder if you might let me know if I've done this the most efficient way or not (code below)?

Secondly, is it also possible to show in some further columns to the right of M:N the percentage of securities in each iteration which outperform/underperform the SUMPRODUCT of D:E?

So from the sample we used above, P8 would show the percentage of the 150 holdings used in the calculation of M8 where the return was greater than SUMPRODUCT of D:E, and Q8 would be the percentage of the 150 where the return was less than that SUMPRODUCT; and S8:T8 would reflect the same but for the sample of 75 used in N8.

Thank you so much for your considerable help on this - I really do appreciate it.


Stu

Code: 
Dim intBL, intES, intWeight As Integer


Sub GenerateAll()

intBL = InputBox("Select number of Buy List securites", "Input Required")
intES = InputBox("Select number of Portfolio securites", "Input Required")
intWeight = InputBox("Select market cap weighted (1) or equal weighted (2) ", "Input Required")

For Each ws In Worksheets
    ws.Select
    Call RandomAverage
Next ws

End Sub

Sub RandomAverage()

    MyList = Range("D8:E" & Range("D" & Rows.Count).End(xlUp).Row)
    Set ResultRange = Range("M8:N1008")
    ResultRange.ClearContents
    Results = ResultRange
    
    For i = 1 To UBound(Results, 1)
        Call GetRandom(MyList, Results, i, intBL, intES)
    Next i
    
    ResultRange.Value = Results
    
End Sub

Sub GetRandom(ByVal MyList, Results, r, Count1, Count2)
Dim List2()

    ReDim List2(Count1, 2)
    
    If UBound(MyList, 1) < Count1 Then Exit Sub
    If Count2 > Count1 Then Exit Sub
    
    Select Case intWeight
        
        Case Is = 1
    
                x = UBound(MyList, 1)
                sum1 = 0
                wgt1 = 0
                For i = 1 To Count1
                    y = Int(Rnd() * x) + 1
                    List2(i, 1) = MyList(y, 1)
                    List2(i, 2) = MyList(y, 2)
                    sum1 = sum1 + List2(i, 1) * List2(i, 2)
                    wgt1 = wgt1 + List2(i, 1)
                    MyList(y, 1) = MyList(x, 1)
                    MyList(y, 2) = MyList(x, 2)
                    x = x - 1
                Next i
            Results(r, 1) = sum1 / wgt1
    
                x = Count1
                sum1 = 0
                wgt1 = 0
                For i = 1 To Count2
                    y = Int(Rnd() * x) + 1
                    sum1 = sum1 + List2(y, 1) * List2(y, 2)
                    wgt1 = wgt1 + List2(y, 1)
                    List2(y, 1) = List2(x, 1)
                    List2(y, 2) = List2(x, 2)
                    x = x - 1
                Next i
             Results(r, 2) = sum1 / wgt1
             
             Case Is = 2
    
                x = UBound(MyList, 1)
                sum1 = 0
                For i = 1 To Count1
                    y = Int(Rnd() * x) + 1
                    List2(i, 1) = MyList(y, 1)
                    List2(i, 2) = MyList(y, 2)
                    sum1 = sum1 + List2(i, 2)
                    MyList(y, 2) = MyList(x, 2)
                    x = x - 1
                Next i
            Results(r, 1) = sum1 / Count1
    
                x = Count1
                sum1 = 0
                For i = 1 To Count2
                    y = Int(Rnd() * x) + 1
                    sum1 = sum1 + List2(y, 2)
                    List2(y, 2) = List2(x, 2)
                    x = x - 1
                Next i
             Results(r, 2) = sum1 / Count1
             
             Case Else
                Exit Sub
            
            End Select
End Sub
 
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
Hi Stu,

A couple of pointers first off. After a thread is solved, I unsubscribe so I won't see if anyone has added a new message. If you do add a new message, it's anyone's guess whether someone will see it. So it's usually best to send a PM (as you did), or open a new thread. You should say something like: "I got some help here (include the link), but need some more help."

Next, your updates to the code weren't bad. One major change I made was to the Select Case structure. The way you did it required you to duplicate a large section of code. I found a simpler way to do it. Also, the way you did it had a somewhat subtle bug in it skewing your results that would have been easier to find if you only had to look through the code once.So here's the new version with your latest requirements:

Rich (BB code): 
Dim intBL As Integer, intES As Integer, intWeight As Integer


Sub GenerateAll()

    intBL = InputBox("Select number of Buy List securites", "Input Required")
    intES = InputBox("Select number of Portfolio securites", "Input Required")
    intWeight = InputBox("Select market cap weighted (1) or equal weighted (2) ", "Input Required")

    For Each WS In Worksheets
         WS.Select
         Call RandomAverage
    Next WS

End Sub


Sub RandomAverage()

    MyList = Range("D8:E" & Range("D" & Rows.Count).End(xlUp).Row)
    Set ResultRange = Range("M8:T1008")
    Results = ResultRange
    
    For i = 1 To UBound(Results, 1)
        Call GetRandom(MyList, Results, i, intBL, intES)
    Next i
    
    ResultRange.Value = Results
    
End Sub


Sub GetRandom(ByVal MyList, Results, r, Count1, Count2)
Dim List2(), List3()

    ReDim List2(Count1, 2)
    ReDim List3(Count2, 2)
    
    If UBound(MyList, 1) < Count1 Then Exit Sub
    If Count2 > Count1 Then Exit Sub
    
    x = UBound(MyList, 1)
    sum1 = 0
    wgt1 = 0
    
    For i = 1 To Count1
        y = Int(Rnd() * x) + 1
        List2(i, 1) = MyList(y, 1)
        List2(i, 2) = MyList(y, 2)
        sum1 = sum1 + List2(i, 1) * List2(i, 2)
        wgt1 = wgt1 + IIf(intWeight = 1, List2(i, 1), 1)
        MyList(y, 1) = MyList(x, 1)
        MyList(y, 2) = MyList(x, 2)
        x = x - 1
    Next i
    Results(r, 1) = sum1 / wgt1
    ctr1 = 0
    For i = 1 To Count1
        If List2(i, 2) > Results(r, 1) Then ctr1 = ctr1 + 1
    Next i
    Results(r, 4) = ctr1 / Count1
    Results(r, 5) = 1 - (ctr1 / Count1)
    
    x = Count1
    sum1 = 0
    wgt1 = 0
    For i = 1 To Count2
        y = Int(Rnd() * x) + 1
        List3(i, 1) = List2(y, 1)
        List3(i, 2) = List2(y, 2)
        sum1 = sum1 + List2(y, 1) * List2(y, 2)
        wgt1 = wgt1 + IIf(intWeight = 1, List2(y, 1), 1)
        List2(y, 1) = List2(x, 1)
        List2(y, 2) = List2(x, 2)
        x = x - 1
    Next i
    Results(r, 2) = sum1 / wgt1
    ctr1 = 0
    For i = 1 To Count2
        If List3(i, 2) > Results(r, 2) Then ctr1 = ctr1 + 1
    Next i
    Results(r, 7) = ctr1 / Count2
    Results(r, 8) = 1 - (ctr1 / Count2)
    
End Sub
 
Last edited:
Upvote 0
Thank you so much Eric, and my sincerest apologies for not fully appreciating forum etiquette in this instance.

I'll have to look at this Monday morning but I really do appreciate your not only helping me with the development but also checking what I'd done - and done incorrectly at that.

Have a terrific weekend, and again, thank you.
 
Upvote 0
Hi Eric,

This works perfectly when selecting the market-cap weighting, however if I select the equal weighting it returns huge percentages in columns M and N, and either 1 or 0 in P:Q and S:T.

Would you mind having a look please?

Hugely appreciate your help thus far.


Stu
 
Upvote 0
This should work better:
Code: 
Dim intBL As Integer, intES As Integer, intWeight As Integer


Sub GenerateAll()

    intBL = InputBox("Select number of Buy List securites", "Input Required")
    intES = InputBox("Select number of Portfolio securites", "Input Required")
    intWeight = InputBox("Select market cap weighted (1) or equal weighted (2) ", "Input Required")


    For Each WS In Worksheets
         WS.Select
         Call RandomAverage
    Next WS


End Sub



Sub RandomAverage()

    MyList = Range("D8:E" & Range("D" & Rows.Count).End(xlUp).Row)
    Set ResultRange = Range("M8:T1008")
    Results = ResultRange
    
    For i = 1 To UBound(Results, 1)
        Call GetRandom(MyList, Results, i, intBL, intES)
    Next i
    
    ResultRange.Value = Results
    
End Sub


Sub GetRandom(ByVal MyList, Results, r, Count1, Count2)
Dim List2(), List3()

    ReDim List2(Count1, 2)
    ReDim List3(Count2, 2)
    
    If UBound(MyList, 1) < Count1 Then Exit Sub
    If Count2 > Count1 Then Exit Sub
    
    x = UBound(MyList, 1)
    sum1 = 0
    wgt1 = 0
    
    For i = 1 To Count1
        y = Int(Rnd() * x) + 1
        List2(i, 1) = MyList(y, 1)
        List2(i, 2) = MyList(y, 2)
        wgt = IIf(intWeight = 1, List2(i, 1), 1)
        sum1 = sum1 + List2(i, 2) * wgt
        wgt1 = wgt1 + wgt
        MyList(y, 1) = MyList(x, 1)
        MyList(y, 2) = MyList(x, 2)
        x = x - 1
    Next i
    Results(r, 1) = sum1 / wgt1
    ctr1 = 0
    For i = 1 To Count1
        If List2(i, 2) > Results(r, 1) Then ctr1 = ctr1 + 1
    Next i
    Results(r, 4) = ctr1 / Count1
    Results(r, 5) = 1 - (ctr1 / Count1)
    
    x = Count1
    sum1 = 0
    wgt1 = 0
    For i = 1 To Count2
        y = Int(Rnd() * x) + 1
        List3(i, 1) = List2(y, 1)
        List3(i, 2) = List2(y, 2)
        wgt = IIf(intWeight = 1, List2(y, 1), 1)
        sum1 = sum1 + List2(y, 2) * wgt
        wgt1 = wgt1 + wgt
        List2(y, 1) = List2(x, 1)
        List2(y, 2) = List2(x, 2)
        x = x - 1
    Next i
    Results(r, 2) = sum1 / wgt1
    ctr1 = 0
    For i = 1 To Count2
        If List3(i, 2) > Results(r, 2) Then ctr1 = ctr1 + 1
    Next i
    Results(r, 7) = ctr1 / Count2
    Results(r, 8) = 1 - (ctr1 / Count2)
    
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question Question
Extracting number from text string
Replies
4
Views
500
Fluff
Fluff
GomaPile
  • Question Question
Coaches Random Numbers
2
Replies
10
Views
504
Eric W
Eric W
N
  • Question Question
Selecting multiple random names from a list, with additional criteria
2
Replies
10
Views
513
Peter_SSs
Peter_SSs
S
  • Question Question
Creating a random sequence of items from a weighted list with no duplicates
Replies
6
Views
217
shg
shg
G
  • Solved
Formula to efficiently find unique set from a number of numeric arrays
Replies
3
Views
67
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,223,886
Messages
6,175,196
Members
452,616
Latest member
intern444

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top