VBA to take a Random 10% sample of rows with data in column A.

anewman5high

New Member
Joined
Aug 25, 2017
Messages
11
Hello,

I'm trying to get a piece of code to sample 10% of rows in a sheet by copying them into another sheet.

I've managed to do this but the caveat is that I only want rows which have data in Column A. The way I've tried to do this so far is by hiding anything without data in column A but the vba still copies the hidden ones over.

This is the code so far:

Code:
Sub TakeSample()
Dim LastRow As Long
Dim NbRows As Long
Dim RowList()
Dim i As Long, J As Long, k As Long
Dim RowNb As Long
Dim s As String
Sheets("All Data").Activate


Application.ScreenUpdating = False
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
    s = i & ":" & i
    If IsEmpty(Cells(i, 1).Value) Then
         Rows(s).EntireRow.Hidden = True
    End If
Next
Application.ScreenUpdating = True
    
    
    Sheets("All Data").Activate
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    NbRows = LastRow * 0.1
    'NbRows = IIf(LastRow < 200, LastRow * 0.1, 10)
    ReDim RowList(1 To NbRows)
    k = 1
    For i = 1 To NbRows
        RowNb = Rnd() * LastRow
        For J = 1 To k
            If (RowList(J) = RowNb) Then GoTo NextStep
        Next J
        RowList(k) = RowNb
        Rows(RowNb).Copy Destination:=Sheets("1 in 10 Sample").Cells(k, "A")
        k = k + 1
NextStep:
    Next i
End Sub
Bonus points if the solution can only select from rows where the data in column A starts with UR.

Even more bonus points if the code can copy the rows below the one picked at random until it finds another row with data in column A.

Thanks in advance, let me know if you need more info!

Alan
 

Steve_

Board Regular
Joined
Apr 28, 2010
Messages
167
Hello,

I'm trying to get a piece of code to sample 10% of rows in a sheet by copying them into another sheet.

I've managed to do this but the caveat is that I only want rows which have data in Column A. The way I've tried to do this so far is by hiding anything without data in column A but the vba still copies the hidden ones over.

Bonus points if the solution can only select from rows where the data in column A starts with UR.

Even more bonus points if the code can copy the rows below the one picked at random until it finds another row with data in column A.

Thanks in advance, let me know if you need more info!

Alan

I doubt this is final, but let me know where we need to go from here.

Code:
Sub Cherry_Picker()
    For i = 0 To 9
        Randomize Timer
        IsValid = False
        Do Until IsValid
            rand_row = CInt(Rnd * Sheets("All Data").UsedRange.Rows.Count / 10) + (1 + (Sheets("All Data").UsedRange.Rows.Count / 10) * i)
            If Left(Sheets("All Data").Cells(rand_row, 1), 2) = "UR" Then
                IsValid = True
                Valid_Count = Valid_Count + 1
                Sheets("All Data").Rows(rand_row).Copy Destination:=Sheets("1 in 10 Sample").Cells(Valid_Count, "A")
            End If
        Loop
    Next i
End Sub
This code will look at your number of rows, and then pick 1 result from each 10% chunk (ie: if 1,000 rows, it will pick a sample from 1-100, then from 201 to 300, then 301 to 400, etc), if column A does not start with "UR" it will pick another sample.
 

anewman5high

New Member
Joined
Aug 25, 2017
Messages
11
I doubt this is final, but let me know where we need to go from here.

Code:
Sub Cherry_Picker()
    For i = 0 To 9
        Randomize Timer
        IsValid = False
        Do Until IsValid
            rand_row = CInt(Rnd * Sheets("All Data").UsedRange.Rows.Count / 10) + (1 + (Sheets("All Data").UsedRange.Rows.Count / 10) * i)
            If Left(Sheets("All Data").Cells(rand_row, 1), 2) = "UR" Then
                IsValid = True
                Valid_Count = Valid_Count + 1
                Sheets("All Data").Rows(rand_row).Copy Destination:=Sheets("1 in 10 Sample").Cells(Valid_Count, "A")
            End If
        Loop
    Next i
End Sub
This code will look at your number of rows, and then pick 1 result from each 10% chunk (ie: if 1,000 rows, it will pick a sample from 1-100, then from 201 to 300, then 301 to 400, etc), if column A does not start with "UR" it will pick another sample.
That's great thanks, it almost does exactly what I was hoping! I have two follow up questions if that's OK.

1. is there a way to copy all rows below the one it's taken at random until it finds the next cell that starts with UR? Essentially the cell starting with UR is the name of the item and the rows below have some information in them with would be useful to copy until it hits the next instance of UR in column A.

2. This is less important but can the count be based on the number of rows which start with UR in column A instead of the total number of filled rows? I've played around with the "UsedRange.Rows.Count" line but I can't get it to work and am probably doing it very wrong!

Thanks again, even if the above two points aren't possible then what you've done is massively useful!

Alan
 

Steve_

Board Regular
Joined
Apr 28, 2010
Messages
167
That's great thanks, it almost does exactly what I was hoping! I have two follow up questions if that's OK.

1. is there a way to copy all rows below the one it's taken at random until it finds the next cell that starts with UR? Essentially the cell starting with UR is the name of the item and the rows below have some information in them with would be useful to copy until it hits the next instance of UR in column A.

2. This is less important but can the count be based on the number of rows which start with UR in column A instead of the total number of filled rows? I've played around with the "UsedRange.Rows.Count" line but I can't get it to work and am probably doing it very wrong!

Thanks again, even if the above two points aren't possible then what you've done is massively useful!

Alan

Please clarify both of your requests. Provide me some examples if possible. I have no doubt what you want is possible. I just need to make sure I fully understand it.
 

Forum statistics

Threads
1,081,480
Messages
5,358,946
Members
400,515
Latest member
Finagill

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top