Excel VBA - Randomly select 3 rows per username - vba

Question

I have a large list of tickets with a total of 6 different user names. What I need the code to do is randomly select 3 rows of data per user (18 total) and hide the rest of the rows, as I only need to see the selected rows.
The code will be something like the below, but I am not sure how to write the "random" part.
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("A2:F" & LastRow)
*Select 3 random rows for user A*
*Select 3 random rows for user B*
*The same for C-F*
*Hide all other rows*
End With

Answer 1

Found this to be an interesting challenge. Something like this should work for you. Commented code for clarity.
Sub tgr()
'Adjust these parameters as necessary
Const sDataSheet As String = "Sheet1"
Const sUserCol As String = "A"
Const lHeaderRow As Long = 1
Const lShowRowsPerUser As Long = 3
Const bSortDataByUser As Boolean = False
'Declare variables
Dim ws As Worksheet
Dim rData As Range
Dim rShow As Range
Dim aData() As Variant
Dim aUserRows() As Variant
Dim lTotalUnqUsers As Long
Dim lMaxUserRows As Long
Dim i As Long, j As Long, k As Long
Dim lRandIndex As Long
'Test if sDataSheet name provided exists in ActiveWorkbook
On Error Resume Next
Set ws = ActiveWorkbook.Sheets(sDataSheet)
On Error GoTo 0
If ws Is Nothing Then
MsgBox "No sheet named [" & sDataSheet & "] found in " & ActiveWorkbook.Name & Chr(10) & _
"Correct sDataSheet in code and try again."
Exit Sub
End If
ws.Cells.EntireRow.Hidden = False 'Reset rows to show all data
'Work with the data range set by parameters
With ws.Range(sUserCol & lHeaderRow + 1, ws.Cells(ws.Rows.Count, sUserCol).End(xlUp))
'Verify data exists in specified location
If .Row < lHeaderRow + 1 Then
MsgBox "No data found in [" & sDataSheet & "]" & Chr(10) & _
"Verify column containing users is Column [" & sUserCol & "] or correct sUserCol in code." & Chr(10) & _
"Verify header row is Row [" & lHeaderRow & "] or correct lHeaderRow in code." & Chr(10) & _
"Once corrections have been made and data is available, try again."
Exit Sub
End If
lTotalUnqUsers = Evaluate("SUMPRODUCT((" & .Address(external:=True) & "<>"""")/COUNTIF(" & .Address(external:=True) & "," & .Address(external:=True) & "&""""))") 'Get total unique users
lMaxUserRows = Evaluate("max(countif(" & .Address(external:=True) & "," & .Address(external:=True) & "))") 'Get max rows per user
If bSortDataByUser Then .Sort .Cells, xlAscending, Header:=xlNo 'If bSortByUser is set to True, then sort the data
Set rData = .Cells 'Store the data in a range object for later use
aData = .Value 'Load the data into an array to speed operations
ReDim aUserRows(1 To lTotalUnqUsers, 1 To 3, 1 To lMaxUserRows) 'Ready the results array that random rows will be selected from
End With
'Load all available rows into the results array, grouped by the user
For i = LBound(aData, 1) To UBound(aData, 1)
For j = LBound(aUserRows, 1) To UBound(aUserRows, 1)
If IsEmpty(aUserRows(j, 1, 1)) Or aUserRows(j, 1, 1) = aData(i, 1) Then 'Find correct user
If IsEmpty(aUserRows(j, 1, 1)) Then aUserRows(j, 1, 1) = aData(i, 1) 'If user isn't in results array yet, add it
k = aUserRows(j, 2, 1) + 1 'Increment row counter for this user
aUserRows(j, 2, 1) = k
aUserRows(j, 3, k) = i + lHeaderRow 'Load this row into this user's group of rows
Exit For
End If
Next j
Next i
'Select random rows up to lShowRowsPerUser for each user from the grouped results array
For j = LBound(aUserRows, 1) To UBound(aUserRows, 1)
Do
Randomize
lRandIndex = Int(Rnd() * aUserRows(j, 2, 1)) + 1
If Not rShow Is Nothing Then
Set rShow = Union(rShow, ws.Cells(aUserRows(j, 3, lRandIndex), sUserCol))
Else
Set rShow = ws.Cells(aUserRows(j, 3, lRandIndex), sUserCol)
End If
Loop While rShow.Cells.Count < j * Application.Min(lShowRowsPerUser, aUserRows(j, 2, 1))
Next j
rData.EntireRow.Hidden = True 'Hide all relevant rows
rShow.EntireRow.Hidden = False 'Only show the rows that have been randomly selected
End Sub