How do I create a form in excel where the user can enter the number of records to be returned from another sheet within the workbook in excel.

[LouLou1234]

Hi there, I am wanting to create a form in excel where the user can input the amount of names they require and that amount of names will populate in an excel worksheet. So on worksheet 2 I have a list of about 500,000 names and on worksheet 1 I want to create a form where the user can say type 200 and then a list of 200 names randomly chosen from the list will be returned. Then if that is possible I would then like a field where they can input what year level should be attached to the names. Eg 150 Year 1, 150 Year 6, 100 Year 7 and 100 Year 12. Then the year level would autopopulate next to the names that were autopopulated. Is this possible? Thanks in advance

 

[Herakles]

Is this a one off job you have to do or is this to be repeated many times?

 

[LouLou1234]

Is this a one off job you have to do or is this to be repeated many times?

Setting up this template will be a one off job but the template will be used multiple times

 

[Herakles]

Instead of creating a form I have taken the information to create the sample data set from a worksheet "SampleSpecification".
See image attached.

It should be obvious what goes where.
You can split the sample size as many times as you like as long as the sum of the year splits equals the sample size.

Test it on a copy of your data.

Public Sub subCreateSampleDataSet()
Dim WsSource As Worksheet
Dim WsDestination As Worksheet
Dim WsSampleSpecification
Dim i As Integer
Dim dictSample As New Scripting.Dictionary
Dim strColumnHeader As String
Dim lngRandom As Long
Dim intNextRow As Integer
Dim rngfound As Range

On Error GoTo Err_Handler

    ActiveWorkbook.Save
        
    dictSample.RemoveAll
    
    Set WsSampleSpecification = Worksheets("SampleSpecification")
    
    Set WsSource = Worksheets(WsSampleSpecification.Range("B1").Value)
    
    ' Check to see if source data contains sufficient rows.
    If WsSampleSpecification.Range("B4").Value > WsSource.Cells(WsSource.Rows.Count, "A").End(xlUp).Row Then
        MsgBox "Sample size is greater then the number of source worksheet rows.", vbOKOnly, "Warning!"
        Exit Sub
    End If
    
    Set WsDestination = Worksheets(WsSampleSpecification.Range("B3").Value)
    
    ' Find column number for sample data.
    strColumnHeader = WsSampleSpecification.Range("B2").Value
    Set rngfound = WsSource.Rows(1).Find(strColumnHeader, LookIn:=xlValues)
    If rngfound Is Nothing Then
        Exit Sub
    End If
    
    ' Prepare destination sheet.
    With WsDestination
        .Cells.ClearContents
        .Range("A1:C1").Value = Array(strColumnHeader, "Year", "RAND")
    End With
    
    ' Add to the dictionary of names until sample size has been reached.
    With WsSource
        Do While dictSample.Count < WsSampleSpecification.Range("B4").Value
            lngRandom = WorksheetFunction.RandBetween(1, .Cells(.Rows.Count, "A").End(xlUp).Row)
            If Not dictSample.Exists(lngRandom) Then
                dictSample.Add Key:=lngRandom, Item:=WsSource.Cells(lngRandom, rngfound.Column).Value
                With WsDestination
                    .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, 1) = WsSource.Cells(lngRandom, 3).Value
                End With
            End If
        Loop
    End With

    intNextRow = 2
    
    ' Allocate year to sample data.
    With WsSampleSpecification
        For i = 5 To .Cells(.Rows.Count, "A").End(xlUp).Row
            With WsDestination.Range("B" & intNextRow).Resize(.Cells(i, 2).Value, 1)
                .Value = "Year " & WsSampleSpecification.Cells(i, 1).Value
                .Offset(0, 1).Formula = "=RAND()"
                .Offset(0, 1).Value = .Offset(0, 1).Value
            End With
            intNextRow = intNextRow + .Cells(i, 2).Value
        Next i
    End With
        
    WsDestination.Activate
        
    If MsgBox("Do you want to apply a random sort to the sample data?", vbYesNo, "Sorting Sample Data") = vbYes Then
        With WsDestination
                .Sort.SortFields.Clear
                .Sort.SortFields.Add2 Key:=Range("C2:C" & .Cells(.Rows.Count, "A").End(xlUp).Row), _
                    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                With .Sort
                    .SetRange Range("A1:C" & WsDestination.Cells(WsDestination.Rows.Count, "A").End(xlUp).Row)
                    .Header = xlYes
                    .Apply
                End With
        End With
    End If
        
    With WsDestination
        .Range("C1").EntireColumn.Delete
        .Range("A:B").EntireColumn.AutoFit
    End With
    
    Set dictSample = Nothing
    
    MsgBox "Sample data created.", vbOKOnly, "Confirmation"
    
Exit_Handler:

    ActiveWorkbook.Save

    Exit Sub

Err_Handler:

    MsgBox "An error has occured, check the specification sheet for inaccurencies.", vbCritical, "Warning!"

    Resume Exit_Handler
    
End Sub