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
 

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.
Sort by date Sort by votes
When you say you have numbers in column E, I assume that you have actual numbers, not something like A123. I also assume that they are unique, although even if they are not, you will not get a duplicate in H or K. Given that:

EFGHIJK
Random selectionRandom from H

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]22[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]22[/TD]

[TD="align: center"]9[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]18[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]10[/TD]

[TD="align: center"]10[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]21[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]18[/TD]

[TD="align: center"]11[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]12[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]14[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]13[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]14[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]15[/TD]
[TD="align: right"]8[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]2[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]16[/TD]
[TD="align: right"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]17[/TD]
[TD="align: right"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"]15[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]18[/TD]
[TD="align: right"]11[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]19[/TD]
[TD="align: right"]12[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]20[/TD]
[TD="align: right"]13[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]21[/TD]
[TD="align: right"]14[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]22[/TD]
[TD="align: right"]15[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]23[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]24[/TD]
[TD="align: right"]17[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]25[/TD]
[TD="align: right"]18[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]26[/TD]
[TD="align: right"]19[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]27[/TD]
[TD="align: right"]20[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]28[/TD]
[TD="align: right"]21[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]29[/TD]
[TD="align: right"]22[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

[TD="align: center"]30[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>
Sheet2​

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Array Formulas[TABLE="width: 100%"]
<thead>[TR="bgcolor: #DAE7F5"]
[TH="width: 10px"]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
</thead><tbody>[TR]
[TH="width: 10px, bgcolor: #DAE7F5"]H8[/TH]
[TD="align: left"]{=LARGE(IF((COUNTIF($H$7:H7, $E$8:$E$100)=0)*($E$8:$E$100<>""),$E$8:$E$100), RANDBETWEEN(1,SUM(IF((COUNTIF($H$7:H7, $E$8:$E$100)=0)*($E$8:$E$100),1))))}[/TD]
[/TR]
[TR]
[TH="width: 10px, bgcolor: #DAE7F5"]K8[/TH]
[TD="align: left"]{=LARGE(IF((COUNTIF($K$7:K7, $H$8:$H$100)=0)*($H$8:$H$100<>""),$H$8:$H$100), RANDBETWEEN(1,SUM(IF((COUNTIF($K$7:K7, $H$8:$H$100)=0)*($H$8:$H$100<>""),1))))}[/TD]
[/TR]
</tbody>[/TABLE]
Entered with Ctrl+Shift+Enter. If entered correctly, Excel will surround with curly braces {}.
Note: Do not try and enter the {} manually yourself[/TD]
[/TR]
</tbody>[/TABLE]



Put the formula in H8, confirm it with Control-Shift-Enter. Then copy it down to H17 (or whatever row you want). Repeat with the formula in K8. You'll have to adjust the $E$8:$E$100 range to the maximum row of your number list. Since empty cells are ignored in this formula, you can put the bottom row well below your actual data.

If your data is not actual numbers, we'd probably have to have a helper column to pick random row numbers, then use INDEX to get the value.

Let me know if this is what you're looking for.
 
Upvote 0
I appreciate the reply Eric (and all of your assumptions regarding the data are spot on), however I was looking to do something in VBA as ultimately I need to loop the scenario 1000 times. I should have mentioned this and I apologise.

To fully explain what I am trying to do, and leaving nothing out:

I have a large list of what are percentage returns of various securities (Column E). I need to extract from this list a random "portfolio" of 150 unique returns, and from THAT list of 150 another random list of 75 unique returns. I then need to create an equally-weighted total return for both of these further columns, i.e. a SUMPRODUCT of the 150 (with each return weighted @ 1/150) and a SUMPRODUCT of the 75 (each return weighted @ 1/75) - and I need 1000 of these final numbers, listed in columns M and N.

Do you think this is something you could help me with? I've actually cribbed something together now for the initial two columns, however first up it's only a job half done, and second it may not be the most efficient way of doing it at all, so I'd really appreciate if you could take a look and let me know your thoughts/suggestions??

I'll remind myself how to post code on here and stick it up.


Thank you,


Stu
 
Upvote 0
Code: 
Sub GenerateUniqueRandomBuyList()

Dim bln() As Boolean
Dim x&
Dim rngStock As Range
Dim rngAll As Range
Dim intCount As Integer
Dim intWithin As Integer
    
    Set rngAll = Range("C8", Range("C8").End(xlDown))
    Let intCount = rngAll.Cells.Count
    Let intWithin = intCount - 8
ReDim bln(1 To intCount)
    Randomize
    
    Set rngStock = Range("H8:H157")
    
    For c = 1 To rngStock.Cells.Count Step 1
        x = Int(Rnd() * intCount) + 1
            If bln(x) = False Then
                rngStock.Cells(c).Value = rngAll.Cells(x).Offset(0, 2).Value
                bln(x) = True
            End If
    Next c

End Sub
Sub GenerateUniqueRandomEquiSarList()

Dim bln() As Boolean
Dim x&
Dim rngStock As Range
Dim rngAll As Range
Dim intCount As Integer
Dim intWithin As Integer
    
    Set rngAll = Range("H8", Range("H8").End(xlDown))
    Let intCount = rngAll.Cells.Count
    Let intWithin = intCount - 8
ReDim bln(1 To intCount)
    Randomize
    
    Set rngStock = Range("K8:K82")
    
    For c = 1 To rngStock.Cells.Count Step 1
        x = Int(Rnd() * intCount) + 1
            If bln(x) = False Then
                rngStock.Cells(c).Value = rngAll.Cells(x).Value
                bln(x) = True
            End If
    Next c

End Sub
Sub Summary()

'''  Next I need to work out the most efficient way of getting the sumproduct of equally weighted into the output cols


End Sub

Sub FullGeneration()

'''' hopefully there is a quicker way - maybe do the calc without filling the cells??

For i = 1 To 1000

Application.ScreenUpdating = False
Application.StatusBar = i

Call GenerateUniqueRandomBuyList
Call GenerateUniqueRandomEquiSarList

Next i

Application.ScreenUpdating = True
End Sub
[code]
 
Upvote 0
If you are doing this 1000 times, then yes, it would be better to perform the analysis without filling the cells. I'd read column E into an internal array and handle it there.

A few questions: once you have your 150 (or 75) values, how do you want to perform the calculation? A weighted average where all the weights are equal is just an average. If you're talking stock returns, those are typically weighted by number of shares, so that 1 share of ABC with a return of 90%, and 1000 shares of XYZ with a return of 10%, doesn't calculate an average return of 50%. How are the values stores? A number, or a percent, or 1+ the percent gain? Where do you want the results? In a thousand rows of the spreadsheet?

Let me know the answers to that, and I'll see what I can do. It'll probably be tomorrow until I can get to it.
 
Upvote 0
Hi Eric, thank you for coming back. Unfortunately I'm not well versed in the art of internal arrays so your assistance would indeed be much appreciated.

In answer to your queries - firstly, you're right, let's avoid equally weighted and go with market cap weighted. I can have the market cap in Column D so we would need to use this to create weightings. Secondly, the market caps would be integers and the returns are percentages. Finally, yes please, I'd like the results in Columns M and N in from rows 8 to 1008 ideally...

Really appreciate your help on this, thank you.


Stu
 
Upvote 0
Hi Stu, I've been busy, but I didn't want to leave you hanging, so I wrote up a basic version of the macro. It's missing some error checking, and instructions, and so on, but it does seem to work as requested. Here it is:

Rich (BB code): 
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, 150, 75)
    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
    
    x = UBound(MyList, 1)
    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
    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
    
End Sub
The range in red is where your range is, weights in D, percentages in E. The range in blue is where you want the results. It also determines how many times to run the subroutine. If your range has 1000 rows, it will run 1000 times. If your range has 27 rows, it will run 27 times. Finally, in orange is where you put the sample sizes. Since I only read/write from the spreadsheet once each, it runs very fast. My testing took under a second for 1000 iterations of about 600 lines of data.

Let me know what you think, and I'll clean it up a bit when I get the chance.
 
Upvote 0
Nuts, I made a basic error. Use this code instead:

Rich (BB code): 
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, 150, 75)
    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
    
    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
    
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