Sort and delete for a random sample?

[JayL.]

All,

I have a repeating scenario I would like to automate.

Monthly I get a spreadsheet with about 30,000 rows by 8 columns. All
Accounts Payable invoice data.

One of the columns (column 'D') contains the initials of a data entry person
that originally entered the data. I need to create a 10% random sample of
each data entry persons work. There are about 12 different people that key
in data that ends up in this spreadsheet.

Manually, I would sort by column 'D' , insert a column and apply a random
function, manually count the quantity of rows per data entry persons
initials and take 10% of that quantity and delete the rest of that persons
rows. Then move on to the next persons initials.



Any help is appreciated!

Jay

 

[zantor]

Hi JayL,

Below is a file called 'Jayl.zip'. If you unzip it you will find a file
called 'JayL.xls'. Have a look through it and see if it is what you
need.

Regards
Zantor

File Attached: http://www.exceltip.com/forum/attachment.php?postid=285781 (jayl.zip)

 

[keepitcool]

To insert the random numbers between 0 and 9
as a new column then make a pivot with the counts by
Typist and random nummber.

Doubleclicking on a cell in the pivot, where the count
will create a sheet with the relevant lines for that typists/random
detailslines.

Th macro assumes a sheet called data and a sheet
called report, where the pivot will be created.

Suc6


Sub PivotForRandom()
Dim heads, itm

'Fill columni with random numbers (values)
With Worksheets("data")
.[i1] = "Random"
With .Range("i2:i" & [a65536].End(xlUp).Row)
.Formula = "=int(rand()*12)"
.Formula = .Value
End With
End With
With ActiveWorkbook
.Names.Add "dnPivSource", _
"=OFFSET(data!$A$1,0,0,COUNTA(data!$A:$A),COUNTA(data!$1:$1))"
.Worksheets("report").Cells.Clear
With .PivotCaches.Add(xlDatabase, "dnPivSource")
.CreatePivotTable [report!A3], "Pivot1"
End With
End With

heads = [dnPivSource].Resize(1)
With Worksheets("report").PivotTables(1)
For Each itm In .VisibleFields
itm.Orientation = xlHidden
Next
.AddFields Array(heads(1, 4)), _
Array(heads(1, 9))
.AddDataField .PivotFields(heads(1, 1)), "Count", xlCount
End With

End Sub







keepITcool

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >

 

[JayL.]

Zantor,

tried to download the file but got an error message 'Attachemnt not
specified'. Feel free to send it to my email address (e-mail address removed).

Thanks!
Jay