|I think I got it.|
The following code should get you what you want.
1 - The code first copies Sheet1 and adds it to the end of the workbook.
2 - It then sorts the new sheet by Name (Column O).
3 - It then loops through the sorted Names and counts how many occurrences of the first Name exists.
4 - Once it knows how many occurrences exist, it takes 10% of that number, rounding up so you always get at least 10%. e.g. 10% of 48 occurrences is 4.8. The code will use 5, so that you get the full 10%, not 4 which is less than 10%.
5 - The code will then randomly choose e.g. 5 rows within the 48 for that Name and build an array with those random row numbers.
6 - Once the array of random row numbers is built, the code will loop through the array, copying the e.g. 5 rows from the sorted sheet to Sheet2.
7 - After the random Rows for the first Name has been copied, the code then counts the number of occurrences of the next Name and repeats steps 4 - 6 over and over until a random 10% of each group of Names has been copied.
8 - Finally, the code deletes the Sheet that it added at the beginning.
Note 1: The data in Sheet2 will still be sorted by Name. If that is an issue, we should be able to fairly easily get it back into its original order.
Note 2: The code assumes that you have Columns Headings in Row 1. It actually starts counting Names in Row 2.
Suggestion 1: You should run this code in a back-up copy of your workbook in case things go terribly wrong.
Suggestion 2: If you are going to be using VBA, you might want to review this How-To.
This tutorial contains a number of useful debugging techniques that can help you understand how the code works and possibly modify it as your requirements change.
Let me know what you think.
Randomize 'Initialize Random number seed
Application.ScreenUpdating = False
'Copy Sheet1 to new sheet
'Clear old data in Sheet 2
'Determine Number of Rows in Sheet1 Column A
numRows = Sheets(Sheets.Count).Cells(Rows.Count, _
'Sort new sheet by Column O
key1:=Sheets(Sheets.Count).Range("O1:O" & numRows), _
'Initialize numNames & startRow variable
numNames = 1
startRow = 2
'Loop through sorted names, count number of current Name
For nameRows = startRow To numRows
If Sheets(Sheets.Count).Cells(nameRows, "O") = _
Sheets(Sheets.Count).Cells(nameRows + 1, "O") Then
numNames = numNames + 1
''Extract Random 10% of current Name, Round Up to next integer
'Set last row of current Name group
endRow = startRow + numNames - 1
'Get 10% of number of current name
percRows = _
WorksheetFunction.RoundUp(numNames * 0.1, 0)
'Allocate elements in Array
'Create Random numbers and fill array
For nxtRow = 1 To percRows
'Generate Random row numbers within current Name Group
nxtRnd = Int((endRow - startRow + 1) * _
Rnd + startRow)
'Loop through array, checking for Duplicates
For chkRnd = 1 To nxtRow
'Get new number if Duplicate is found
If MyRows(chkRnd) = nxtRnd Then GoTo getNewRnd
'Add element if Random number is unique
MyRows(nxtRow) = nxtRnd
'Loop through Array, copying rows to Sheet2
For copyRow = 1 To percRows
dstRow = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row + 1
'Set Start Row for next Name Group, reset numNames variable
startRow = endRow + 1
numNames = 1
'Delete new sheet
Application.DisplayAlerts = False
Application.DisplayAlerts = True
Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.