make a random selection from 5 cells in a filtered sheet

Hi all,

I found some code to make a random selection of 5 cells that then I paste into a second sheet for further processing.
the code does not seem to actually make a random selection, but maybe it is just me.
First I use a filter to to have only cases status in column D with Complete. Then the random code should run and give me 5 random cells from column A.
It actually uses all of the cells in a selection, but just ingores the filter and takes also cells that are not in the filtered ragne.

I get the excel file from a csv export and the sheet has the date in the sheet name.

Any chance the below code could be adjusted to work:

Sub GetRandom()
    Dim iRows As Integer
    Dim iCols As Integer
    Dim iBegRow As Integer
    Dim iBegCol As Integer
    Dim J As Integer
    Dim sCells As String
    Dim LastRow As Long
    Set TempDO = New DataObject
    
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
    LastRow2 = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row

    
      Rows("1:1").Select
        Selection.AutoFilter
            ActiveSheet.Range("A1:A" & LastRow).AutoFilter Field:=4, Criteria1:="Complete"
    Range("A2:A" & LastRow2).Select
    
    iRows = Selection.Rows.Count
    iCols = Selection.Columns.Count
    iBegRow = Selection.Row
    iBegCol = Selection.Column
    
    If iRows < 16 Or iCols > 1 Then
        MsgBox "Too few rows or too many columns"
    Else
        Randomize Timer
        sCells = ""
        For J = 1 To 5
            iWantRow = Int(Rnd() * iRows) + iBegRow
            sCells = sCells & Cells(iWantRow, iBegCol) & vbCrLf
        Next J
        TempDO.SetText sCells
        Sheets("Sheet1").Select
        TempDO.PutInClipboard
        Range("A1").PasteSpecial

    End If
End Sub

Greetings.

hi,

I fixed the code some how to filter the ones I don't need and then delete them. I need to do this twice (also for second criteria) and it works perfect this way.

I still have problems with the random selection as it tends to select often 2 times the same number in the range selected.
Any way this could be avoided? maybe it would have to check if the number is not in the selection and then if so, go for another round of random selection (this is over my head to come up with)

this is the code I got so far:

' use this dll if  "Set TempDO = New DataObject" does not work: FM20.DLL
Sub GetRandom2()
    Dim iRows As Integer
    Dim iCols As Integer
    Dim iBegRow As Integer
    Dim iBegCol As Integer
    Dim J As Integer
    Dim sCells As String
    Dim LastRow As Long
    Set TempDO = New DataObject
    
    LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
        
      Rows("1:1").Select
        Selection.AutoFilter
            ActiveSheet.Range("A1:A" & LastRow).AutoFilter Field:=4, Criteria1:="<>Complete"
                
                        
           LastRow2 = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
            
            Range("A2:A" & LastRow2).EntireRow.Delete shift:=xlUp
            
            Selection.AutoFilter
            
            LastRow4 = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
            
            Selection.AutoFilter
            
            ActiveSheet.Range("A1:A" & LastRow4).AutoFilter Field:=3, Criteria1:="<>Awaiting 2nd check"
            
            
             LastRow5 = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
            
            Range("A2:A" & LastRow5).EntireRow.Delete shift:=xlUp
            

Selection.AutoFilter
            
            LastRow3 = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row
            
    Range("A2:A" & LastRow3).Select
    
    iRows = Selection.Rows.Count
    iCols = Selection.Columns.Count
    iBegRow = Selection.Row
    iBegCol = Selection.Column
    
    If iRows < 16 Or iCols > 1 Then
        MsgBox "Too few rows or too many columns"
    Else
        Randomize Timer
        sCells = ""
        For J = 1 To 5
            iWantRow = Int(Rnd() * iRows) + iBegRow
            sCells = sCells & Cells(iWantRow, iBegCol) & vbCrLf
        Next J
        TempDO.SetText sCells
                Worksheets.Add().Name = "Selection"
        
        Sheets("Selection").Select
        TempDO.PutInClipboard
        Range("A1").PasteSpecial

    End If
End Sub

Greetings.