Autofilter 10 percent of entire data vba

[Deepti]

Hi all,

I am looking for vba whereby i can filter 10 percent of data for audit percent randomly. can anyone suggest the vba code for the same

 

[Yongle]

The code below
- column A determines the number of rows
- text "Select" is added in column K (column A = column 1 offset by 10 columns= column K)
- message box added at end listing row number and value of cel in column A

To test
- create a simple sheet containing values only in column A
- amend the 2 constants

Sub AuditSample()
    Const sName = "[COLOR=#ff0000]MySheetName"[/COLOR]
    Const myOffset = [COLOR=#ff0000]10[/COLOR]
    Dim cel As Range, rng As Range, msg As String
    
    With Sheets(sName)
        Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For Each cel In rng
        If WorksheetFunction.RandBetween(1, 10) = 1 Then
            cel.Offset(, myOffset) = "Select"
            msg = msg & vbCr & cel.Row & vbTab & cel.Value
        End If
    Next
    MsgBox msg, vbOKOnly, "Selected for audit"
End Sub

 

[Yongle]

If you prefer the list created on a different sheet use something like this
- amend constant to name of sheet containing the data

Sub AuditSheet()
    Const sName = "[COLOR=#ff0000]MySheetName[/COLOR]"
    Dim cel As Range, rng As Range, ws As Worksheet, r As Long
    
    Set ws = Worksheets.Add: ws.Name = "Audit": ws.Range("A1:B1").Value = Array("Row", "Item")
    r = 1
    With Sheets(sName)
        Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For Each cel In rng
        If WorksheetFunction.RandBetween(1, 10) = 1 Then
            r = r + 1
            ws.Cells(r, 1).Resize(, 2) = Array(cel.Row, cel.Value)
        End If
    Next
End Sub

 

[Deepti]

If you prefer the list created on a different sheet use something like this
- amend constant to name of sheet containing the data

Sub AuditSheet()
    Const sName = "[COLOR=#ff0000]MySheetName[/COLOR]"
    Dim cel As Range, rng As Range, ws As Worksheet, r As Long
    
    Set ws = Worksheets.Add: ws.Name = "Audit": ws.Range("A1:B1").Value = Array("Row", "Item")
    r = 1
    With Sheets(sName)
        Set rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
    End With
    
    For Each cel In rng
        If WorksheetFunction.RandBetween(1, 10) = 1 Then
            r = r + 1
            ws.Cells(r, 1).Resize(, 2) = Array(cel.Row, cel.Value)
        End If
    Next
End Sub

Thank you for providing but this is giving the Rand number. I want that 10 percent of entire data get filtered and paste into other sheet can you suggest

 

[Yongle]

To copy the whole row perhaps..

REPLACE

ws.Cells(r, 1).Resize(, 2) = Array(cel.Row, cel.Value)

WITH

cel.Resize(, Columns.Count).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)

 

[Deepti]

To copy the whole row perhaps..


REPLACE

ws.Cells(r, 1).Resize(, 2) = Array(cel.Row, cel.Value)

WITH

cel.Resize(, Columns.Count).Copy ws.Range("A" & Rows.Count).End(xlUp).Offset(1)

Thank you for your support. But still the issue is not resolved. Every time the output is changing though my criteria is Same. Really can't understand why the output count is changing

 

[Deepti]

The count should be same everytime I run the code 10percent of data. However when I run the code you provided the count of rows changes after every run. Can you suggest