Selecting a random 10% of data from different tabs

Tori Murphy

New Member
Joined
Jul 5, 2022
Messages
10
Office Version
  1. 2013
Platform
  1. Windows
Hi Everyone.

I am a total newbie to Macros, I love them, think they are amazing but have no clue how to use them or make them so I am praying someone out there can help me. I have googled this to hell and back and I'm still none the wiser!

I have an excel document with 5 tabs containing data. I would like to select a random 10% from each tab so that information can be placed in a new 'audit tab'. I guess it would be like a VLookup but randomly and without an originating source.

God this sounds so much easier now I've typed it.

Any help would be super appreciated.

Thanks

Tori
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
first attempt
VBA Code:
Sub random10()
     Set dict = CreateObject("scripting.dictionary")

     For Each sh In ThisWorkbook.Worksheets     'loop all worksheets
          If sh.Name <> Sheets("random10").Name Then     'not this one
               ll = sh.Range("A" & Rows.Count).End(xlUp).Row     'last line
               arr = sh.Range("A1").Resize(ll).Value     'read A column to array
               seq = [transpose(row(A1:A65000))]     'hopefully your last line < 65.000
               ptr = 0     'reset pointer
               For i = UBound(arr) To 1 Step -1     'loop random pick 1 once
                    r = Application.RandBetween(1, i)
                    If Len(arr(r, 1)) > 0 Then     'there was data in that cell
                         dict.Add dict.Count, Array(sh.Name, arr(r, 1))     'add to dictionary
                         ptr = ptr + 1     'increment pointer
                         If ptr > UBound(arr) * 0.1 Then Exit For     '10% achieved
                    Else
                         arr(r, 1) = arr(i, 1)
                    End If
               Next
          End If
     Next

     Sheets("random10").Range("A1").Resize(dict.Count, 2).Value = Application.Index(dict.items, 0, 0)

End Sub
 
Upvote 0
Morning BSALV.

Thank you so much for this.

I think this is where I'm going to highlight how much I don't know about VBA/Macros.

I've copied and pasted the above into the code page (this workbook code), but it's not doing anything.

Would you mind telling me what I need to do on a level of "I'm really thick"

I'm sorry to be a pest.
 
Upvote 0
Tori Murphy
there are 3 sheets with data and one sheet "Random10" for the summary.
In those sheets, the first column is the rownumber (that isn't necessary, but here to show that one row 'll never have itself as duplicate) and x other columns. The macro random picks 10% of the rows and copies the content of the 1st 6 columns to "Random10"
 
Upvote 0
Ok, I think I've got it. I'll have another crack at it, but no doubt I'll be lost again!

Thanks again sweets x
 
Upvote 0
Have you tested the random result fully?
Not sure if it requires the 10% must be unique records or not, but I assume it should.
In that case, does the code work, and where?
 
Upvote 0
Have you tested the random result fully?
Not sure if it requires the 10% must be unique records or not, but I assume it should.
In that case, does the code work, and where?
I'm trying to figure out how to use the code in excel. This is totally my first time at doing any kinda code.

I've not had chace to look at it yet. It may even be an after work job!
 
Upvote 0
in the macro, you find this line
VBA Code:
If ptr >= UBound(arr) * 0.1 Then Exit For      '10% achieved : YOU CAN MODIFY THIS TO 0.99 AND CHECK IF THERE ARE NO DUPLICATES IN THE TABLE
so change the 0.1 into 1 (destination equal number as source = all rows are reused) and afterwards remove the duplicates the resulting table on the sheet "Random10" and excel 'll tell you nothing removed !
 
Upvote 0
that line where i made a sequencial array (1,2,3,4,...,65000) can be changed into
Rich (BB code):
seq = Evaluate("transpose(row(A1:A" & ll - fl + 1 & "))") 'hopefully your last line < 65.000 (problem with the transpose)
In that way you get a sequence equal to the number of data in your sheet ( and hopefully less then 65.536, otherwise that sequence has to be made in a loop).

Now to make it easy, suppose there are only 10 rows, my sequence is 1,2,3,...,10.
Compare it with random picking a cart out of 10, 2nd time out of 9, 3rd time out of 8, .... . So after the 10nd pick, there are no cards left.

in the macro
1. Take a random number, for example 7, check if that number is okay, suppose yes, then add the 7nd row to the dictionary and swap the last number of that lot (=10nd element of the array) with the 7th, so seq(7) is now 10. In that way the number 10 is still in the running in the first 9 elements of the array.
the array Seq 'll look like 1,2,3,4,5,6,10,8,9,10 (10 is copied in position 7 and the first 9 still in the running)
2. Take a random number out of the first 9 elements of the array, suppose 3, if it's okay or not, you'll add it or not to the dictionary, but as last action you copy the 9th element of the array to the 3rd position.
Your array 'll look like this after that 2nd time 1,2,9,4,5,6,10,8,9,10 with only the first 8 in the running.
etc
Do you understand ?
 
Upvote 0
Firstly I want to say thank you both for your help.

Secondly I have finally got the time to give this the attention it needs.

BSALV - I've entered and saved your code, when I try and run this, it comes back with error and wants to debug. When I click on the debug the VBA opens and the first line is highlighted:

If sh.Name <> Sheets("random10").Name Then

(I did warn you I'm new to this)
 
Upvote 0

Forum statistics

Threads
1,223,243
Messages
6,170,967
Members
452,371
Latest member
Frana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top