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

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

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

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

put in K10 the formula

Code:

---

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

---

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

Code:

---

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

---

Thanks a lot Admin...