kseguf79

Option Explicit

Sub kseguf79()
Dim srcWS As Worksheet      'Worksheet I want to grab data from
Dim destWS As Worksheet     'Worksheet where I want to drop data
Dim i As Long               'for iterating through things
Dim usedRowsDic As Object   'keeping track of rows I have already selected
Dim outArray() As Variant   'the array data structure I want to store my records in for eventual output
Dim lastrow As Long         'the last row of the source worksheet
Dim bigArray As Variant     'read all the data into an array for fasterer processing
Dim desiredRecs As Long     'number of records to select
Dim recsGathered As Long    'running count of records I have gathered so far
Dim rec As Long             'record I want to add/check right noe

    'set workbooks, dictionary
    Set srcWS = ThisWorkbook.Worksheets("Source Data")
    Set destWS = ThisWorkbook.Worksheets("Destination")
    Set usedRowsDic = CreateObject("scripting.dictionary")

    'number of records to select
    desiredRecs = 300

    'find the last row of our data
    lastrow = srcWS.Range("A" & Rows.Count).End(xlUp).Row

    'our full dataset - adjust columns as needed
    bigArray = srcWS.Range("A2:H" & lastrow)

    'resize our outarray to accomodate the number of records desired
    ReDim outArray(LBound(bigArray, 1) To desiredRecs, LBound(bigArray, 2) To UBound(bigArray, 2))

'select random records
    Do Until recsGathered = desiredRecs
        Randomize
        'select one of our records at random, if we have 20 rows, select a random number between 1, 20
        rec = WorksheetFunction.RandBetween(LBound(bigArray, 1), UBound(bigArray, 1))
        'check if this record number is already in our dictionary, if not, add it to our dictionary
        If Not usedRowsDic.exists(rec) Then
            'increment our "Gathered records" counter
            recsGathered = recsGathered + 1
            'populate our "outarray" with data from our "BigArray" - may be a better way to do this
            For i = LBound(outArray, 2) To UBound(outArray, 2)
                outArray(recsGathered, i) = bigArray(rec, i)
            Next i
            'add this record number to our dictionary so we don't select it again
            usedRowsDic.Add rec, True
        End If
    Loop
'output
    'drop out our "outarray" when we are done
    destWS.Range("A2").Resize(desiredRecs, UBound(outArray, 2)).Value = outArray
'    MsgBox (usedRowsDic.Count)
    Erase outArray
    Erase bigArray
    Set usedRowsDic = Nothing
    Set srcWS = Nothing
    Set destWS = Nothing

End Sub