Excel VBA - Selecting random rows based on multiple criteria - vba

Question

I have the below code set which takes a list of ticket data, and randomly selected three rows based on the username in Col D.
However, with a recent change in our ticketing system, I now need to update it to not select certain tickets. Specifically, I need only INC and SCTASK tickets to be selected, and not RITM tickets.
I am not quite sure how to add the filter so that tickets with RITM in the ticket number (ticket numbers are in Col A) are not included in this search.
Sub DailyTicketAudit()
'Set parameters and variables
Const sDataSheet As String = "Page 1"
Const sUserCol As String = "D"
Const lHeaderRow As Long = 1
Const lShowRowsPerUser As Long = 3
Const bSortDataByUser As Boolean = False
Dim wb As Workbook, ws As Worksheet
Dim rData As Range, rShow As Range
Dim aData() As Variant, aUserRows() As Variant
Dim i As Long, j As Long, k As Long, lRandIndex As Long, lTotalUnqUsers As Long, lMaxUserRows As Long
Set wb = Workbooks.Open("D:\Users\stefan.bagnato\Desktop\Raw Data Files\Audit Tickets Created")
Set ws = ActiveWorkbook.Sheets(sDataSheet)
Sheets("Page 1").name = "Audit Tickets"
'Work with the data range set by parameters
With ws.Range(sUserCol & lHeaderRow + 1, ws.Cells(ws.Rows.Count, sUserCol).End(xlUp))
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) & "&""""))")
lMaxUserRows = Evaluate("max(countif(" & .Address(external:=True) & "," & .Address(external:=True) & "))")
If bSortDataByUser Then .Sort .Cells, xlAscending, Header:=xlNo
Set rData = .Cells
aData = .Value
ReDim aUserRows(1 To lTotalUnqUsers, 1 To 3, 1 To lMaxUserRows)
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
If IsEmpty(aUserRows(j, 1, 1)) Then aUserRows(j, 1, 1) = aData(i, 1)
k = aUserRows(j, 2, 1) + 1
aUserRows(j, 2, 1) = k
aUserRows(j, 3, k) = i + lHeaderRow
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
rShow.EntireRow.Hidden = False
'Format table
'Sort by Opened By
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Worksheets("Audit Tickets").Sort.SortFields.Add Key:=Range("D1"), SortOn:=xlSortOnValues, Order:=xlAscending
With Worksheets("Audit Tickets").Sort
.SetRange Range("A2:G" & LastRow)
.Orientation = xlTopToBottom
.Apply
End With
'Widen columns
Range("A:B,G:G").ColumnWidth = 15
Columns("C:D").ColumnWidth = 18
Columns("E:E").ColumnWidth = 50
Columns("F:F").ColumnWidth = 22
'Wrap text
Range("E1:E" & LastRow).WrapText = True
End Sub

Answer 1

Far more efficient, assuming aData holds all the data and the first column is tickets, is to simply process only the two of interest with the following.
Change 1 in aData(i, 1) to whichever column holds the items of interest in the array.
For i = LBound(aData, 1) To UBound(aData, 1)
If aData(i, 1) = "INC" Or aData(i, 1) = "SCTASK" Then
For j = LBound(aUserRows, 1) To UBound(aUserRows, 1)
''other code
End If
Next i

Answer 2

You could use advanced filter:
Sheets("Emps").Range("A1:D8").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("Emps").Range("F5:F6"), CopyToRange:=Range("A1:B1"), _
Unique:=False
Data to selectively copy:
Data copied:
Reference this short YouTube video; You can record a marco to help yourself with the code also:
https://www.youtube.com/watch?v=bGUKjXmEi2E
A more thorough tutorial is found here:
http://www.contextures.com/xladvfilter01.html
This tutorial shows how to get the source data from outside Excel:
https://www.extendoffice.com/documents/excel/4189-excel-dynamic-filter-to-new-sheet.html
This tutorial shows how to split data values based on a column to different sheets (Fruit column; Apple sheet, Pear sheet, etc.):
https://www.extendoffice.com/documents/excel/2884-excel-save-filtered-data-new-sheet-workbook.html