I have a spreadsheet with 60 groups 4

[bnageshrao]

I have a spreadsheet with 60 groups for a total of 2400 records. Is it possible to select randomly from each of these groups.

 

[SimonDavis]

There's not really enough description there to answer the question.

What defines a group? Does each group have the same number of records?

You should be able to make a very simple piece of code that generates a random number, which you could use to 'jump' to a particular area. The vb syntax for this is something like:

dim rnum
randomize
rnum = int(rnd*60)

This will assign a random number to the variable rnum, between 0 and 59. You can use this number to reference your group.

 

[DaleWatson123321]

Hi bnageshrao,

Because of having to speculate on your specific situation, I will suggest two possible options:

1) IF the groups are in set positions which are clearly identifyable, perhaps it would be reasonable to simply "Go To" a group by hitting the "Go To Key" ( F5 ), followed by the number of that group. To make this Go To option possible, you would need to assign a Range Name to each group (assigning the name to the top row or 1st cell of a group would be adequate). Excel will not allow you to assign Range Names which begin with a number, but you could use numbers which are preceeded with a permissable character - examples: _1 _2 _3 _4 etc.

2) IF it would be preferable to EXTRACT the data to a separate sheet, and at the same time automatically set up a print-range for this extracted data, the following code could be modified to suit your needs.

You need to appreciate that this option requires that you first assign the following Range Names

"data" - assign to your database, with the top row containing your "field" names.

"group_criteria" - assign this name to a range which consists of the field name of the column containing the name or number which uniquely identifies the group, and the cell below the field name, which is where you enter the number of the group you wish to extract.

"output" - assign this name to a range on a separate sheet.
Assign it to the top row of the range where you want to extract your data. This top row needs to contain the field names of those columns you want included from your database.
CAUTION: Excel will automatically delete ALL data immediately below this "output" range.

In automating an extraction routine, you would prompt the user to enter the group identifier (name or number) which your code would then enter into the "group_criteria" (the cell below the field name).

The nice thing about this extraction process, is that it easily ISOLATES the Group data, for viewing and/or printing.

Here is the code:

Sub Extract_Group()
Application.ScreenUpdating = False
Range("data&quot.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="group_criteria", _
CopyToRange:=Range("output&quot, _
Unique:=False
Application.Goto Reference:="output"
Set_ALL_Print_Range
Application.ScreenUpdating = True
Application.Goto Reference:="R1C1"

End Sub

Sub Set_Print_Range()

FirstCell = ActiveCell.Address
Get_Last_Row
LastColumn = "G"
LastCell = LastColumn & LastRow
Print_Range = FirstCell & " : " & LastCell
Range(Print_Range).Name = "PR"
ActiveSheet.PageSetup.PrintArea = "PR"
ActiveSheet.PageSetup.PrintTitleRows = "$1:$4"
End Sub


Sub Get_Last_Row()

ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(3, 0).Select
ActiveCell.End(xlToLeft).Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
End Sub


I hope you will be able to make use of one of the two options.


Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

 

[bnageshrao]

Well it is my fault that I did not give a good description of the problem. So here it is

I run a query and export the result to excel. The number of records generated by query keeps on changing every time the query is run depending on the criteria. My question is once the data is in excel, I want to pick up some random records. Let us say the query generates 2400 records. These 2400 records belongs to 60 groups say G1, G2, G3, .....G60 and each may contain different number of records but the sum of all those groups will be equal to 2400. Is there a way in excel to automatically detect the number of records in each group and then select a certain % of those as random numbers?

 

[DaleWatson123321]

Hi bnageshrao,

In order to properly deal with your challenge, I needed to develop a working model which I am prepared to email you once you provide your email address.

For any others who might also benefit from this sample model, I am also prepared to email you a copy of this Excel file. My email address is: dwatson@bsi.gov.mb.ca (repeated at the bottom of this response).

The file is called "Sixty Groups_Random Selection.xls", and has 3 sheets.

The first sheet (called "DB&quot contains the sample database, above which is a brief explanation of the function of the file, along with a button named "Extract Specified Group's Records to "Random_Data" sheet. Also on this sheet is a cell labelled "Group Number" - for the user to specify the Group to extract, and "Percent of Group" - for the user to specify the percent of the Group's records to include. Finally, on the first sheet, there is a button, attached to which is VBA code which performs the following:

1) extracts the Group's data to the following sheet (called "Random_Numbers&quot

2) The code then creates RANDOM numbers using Excel's "RAND" function. These random numbers are used to create a set of criteria (called "rand_crit&quot which is used to extract the Group's RANDOM-selected records to the third sheet (called "Random_Data&quot.

Included in the code and worksheet are routines/formulas which test for DUPLICATE random numbers, to ensure the Random numbers extracted do NOT contain any duplicates.

For those who might like to "scan" the code, I will provide it ...next. But for FULL appreciation, you should really view the actual file.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca


============
Code follows:
============


Option Explicit

Dim numtofill As Double
Dim startnum As Double
Dim lastrow As String
Dim startcell As String
Dim sourcecells As Range
Dim fillcells As Range
Dim fillrange As Range
Dim endcell As String
Dim cnt As Double
Dim ext_records As Double
Dim rand_nums As Range
Dim randnums As Variant
Dim exist As Double
Dim numrows As Variant
Dim randcr As Variant

Sub Main_Routine()
Application.ScreenUpdating = False
Extract_Group_Data
Extract_Random_Numbers
Set_Rand_Crit
Extract_Random_Data
Worksheets("Random_Data&quot.Select
Range("A1&quot.Select
Application.ScreenUpdating = True
End Sub

Sub Extract_Group_Data()
Range("data&quot.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="crit", _
CopyToRange:=Range("ext_out&quot, _
Unique:=False
End Sub

Sub Extract_Random_Numbers()
Worksheets("Random_Numbers&quot.Range("random_numbers&quot.ClearContents ' delete existing random numbers
Worksheets("Random_Numbers&quot.Select
Range("RandCr_top&quot.Select
ActiveCell.offset(1, 0).Select
Range("RandCr_top&quot.Select
ActiveCell.offset(1, 0).Select
Create_Random_Numbers
End Sub

Sub Create_Random_Numbers()
ext_records = Worksheets("Random_Numbers&quot.Range("NumToExt&quot
cnt = 0
For cnt = 1 To ext_records
Range("RandNum&quot = Range("RandNumForm&quot
ActiveCell = Worksheets("Random_Numbers&quot.Range("RandNum&quot
ActiveCell.offset(1, 0).Select
If Worksheets("Random_Numbers&quot.Range("existnum&quot > 1 Then 'ensures no duplicate numbers
cnt = cnt - 1
ActiveCell.offset(-1, 0).Select
End If
Next
End Sub

Sub Set_Rand_Crit()
Worksheets("Random_Numbers&quot.Select
Range("RandCr_top&quot.Select
startcell = ActiveCell.Address
numrows = Range("NumToExt&quot
ActiveCell.offset(numrows, 0).Select
endcell = ActiveCell.Address
randcr = startcell & ":" & endcell
Range(randcr).Name = "rand_crit"
End Sub

Sub Extract_Random_Data()
Range("ext_random&quot.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:="rand_crit", _
CopyToRange:=Range("rand_data_out&quot, _
Unique:=False
End Sub


===========
End of Code
===========

 

[bnageshrao]

My e-mail address is bnageshrao@yahoo.com

 

[DaleWatson123321]

======================
UPDATE TO THIS POSTING
======================

For anyone interested, Banur Nageshrao, the originator of this posting, confirmed that the example file I created for him was indeed EXACTLY WHAT HE WANTED.

In case anyone else can use this example, I thought it important to confirm that example file was "RIGHT ON THE MARK", and therefore could serve as a good example for others.

If you are interested in a copy, simply email me and I will gladly attach a copy of the file by return email.

Regards, ...Dale Watson dwatson@bsi.gov.mb.ca

--------------------------------------------------------
The following is Banur Nageshrao's email response upon receiving my sample Excel file.
--------------------------------------------------------

From: Banur Nageshrao [bnageshrao@yahoo.com]
Sent: Friday, August 10, 2001 5:06 PM
To: Watson, Dale
Subject: Re: Latest Version - Accumulates ALL Groups

Hi Dale
Works great and that is exactly what I wanted. Now I
have to modify to fit my application. You did with 4
fields and mine has 7 fields. I will try by copying my
data and pasting in your application and see how it
works, because copying your code and pasting in my
application may be a combersome procedure because in
project window I saw some other projects like
atpvbaen.xls(ATPVBAEN.XLA) and funcres(FUNCRES.XLA).
Is it required to run our application. When I clicked
on those two, it seems they are password protected.
Anyway your code is simple and works like a champ. So
thanks once again. I will let you know how it works
with my application. Have a Great week end.

Banur

 

[Databaseguy]

Hey Banur.

ATPVBAEN.XLA and FUNCRES.XLA are box stock Microsoft Office Add In's that you add using, well, the Add In Manager.

Tyrone Lumley
augerinn@gte.net

http://server47.hypermart.net/databaseguy

 

[DaleWatson123321]

Hi Ty,

You're a "fountain of knowledge". Those "mysterious" XLA files were always a mystery to me as well. I simply learned to ignore them, but it's reassuring to know how they came to exist.

Hopefully others who read this will also become a "little wiser" about some of the "behind the scenes" things which occur with Microsoft Office.

Cheers, and thanks.

...Dale Watson dwatson@bsi.gov.mb.ca