Random Unique Value Generator Based On Sample Size And Maximum Items Limit

[bmbalamurali]

Hi All,

Thanks for your precious time in supporting me, my need is that i have a set of reference number in my excel sheet and i have desired counts (sample size) that i need to randomly select from the set of reference numbers and allocate them to few persons in next sheet (that i will be input their name and how many reference numbers should be allocated to a particular person, the persons and their count will change daily)

I uploaded my sample workbook, please download and help me in this regard.

Pls come back if any of my explanation is not understandable.

Once again thanks for your precious time.....friends...`



i have already posted this thread in excel forum for reference pls see below

Need to organize data based on requirements....explained below (http://www.excelforum.com/excel-programming-vba-macros/959743-need-to-organize-data-based-on-requirements-explained-below.html#post3430199)

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA (https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA)

[patel]

put in K10 the formula

=COUNTIF($D$2:$D$61,J10)

[Excel Fox]

Paste this to the code module of the respective sheet and run the macro.



Sub RandLookUp()

Dim lng As Long
Dim lngMax As Long: lngMax = Range("L5").Value
Dim lngMin As Long: lngMin = Range("K5").Value
Dim strNames(1 To 5000) As String

With CreateObject("Scripting.Dictionary")
Do While .Count <= Range("K7").Value 'lngMax - lngMin 'removed the greater than symbol
lng = Rnd * (lngMax - lngMin) + lngMin 'removed the +1
.Item(lng) = Empty
Loop
lngMin = Empty
For lng = 1 To Range("J10:J18").Rows.Count
If Not IsEmpty(Range("J10:J18").Cells(lng, 1)) Then
For lngMax = 1 To Range("J10:J18").Cells(lng, 2).Value
lngMin = lngMin + 1
strNames(lngMin) = Range("J10:J18").Cells(lng, 1).Value
Next lngMax
End If
Next lng
Range(Range("A2"), Cells(Rows.Count, 1).End(xlUp)).Resize(, 4).ClearContents
Range("A2").Resize(Range("K7").Value).Value = Application.Transpose(.Keys)
Range("B2").Resize(Range("K7").Value, 2).Formula = "=VLOOKUP($A2,Sheet1!$A:B,COLUMN(),0)"
Range("D2").Resize(Range("K7").Value).Value = Application.Transpose(strNames)
End With

End Sub

[bmbalamurali]

Thanks a lot Admin...