Great, that works a treat. I have a couple of questions...
1) Could I easily get the test to be drawn from more than one bank of
questions - ie choose 5 from bank 1 and 10 from bank 2 - in order to
give me a little more control over the level of the test?
2) Can I add a button or is there some other easy way to run the macro
when a user opens the worksheet?
3) Is it possible to format the worksheet so that the questions appear
accross a range of columns in order to fit 100 or so onto one sheet?
Really grateful for the help
On 28 Oct, 12:05, Paul Schreiner <schreiner_p...@att.net> wrote:
> As with any question, there are as many
> approaches to an answer as there are people
> attempting an answer!
>
> Have you done any VBA programming?
> I threw together a macro to do this in about
> 10 minutes. Then it took another 20 minutes
> to put together test data and add comments!
>
> One method I prefer is the use of a Dictionary Object.
> it has the benefit of being automatically INDEXED.
> so as you can quickly determine if an entry exists.
>
> here's my macro.
> I created 1000 sample questions.
> It randomly selects 100 and builds a "sample test"
> in less than 1 second.
>
> Now, as a teacher in a former life, I took it a
> step further (if you're interested).
> I thought:
> "I want to make 10 DIFFERENT tests, selecting
> 100 questions for each from my 1000.
> but I also want to build an ANSWER SHEET!"
>
> Of course, that's not the question you asked, so
> here's the macro I created:
>
> If you need help adding it to your Excel file, let me know!
>
> Paul
>
> '-------------------------------------------
>
> Option Explicit
> Sub Make_Test()
> Dim QRequired, QCnt_All, Qnum
> Dim Dict_Questions, Qkeys, I
> ' This macro assumes an Excel file with 3 sheets described:
> '---------------------------------------------------------
> ' Sheet "Make Test"
> ' Cell "A1" has the number of questions to select
> '---------------------------------------------------------
> ' Sheet "All Questions"
> ' Column "A" has a question "number"
> ' Column "B" has the question
> ' Row 1 is a column "header", not a question to include
> ' Number of questions is limited by the Excel version.
> ' (Excel97: 65535 Excel2007: 1048575)
> '---------------------------------------------------------
> ' Sheet "Test Questions"
> ' No header row
> ' Column "A" will be sequential from 1 to total questions
> ' Column "B" will be the random question
> '---------------------------------------------------------
> Set Dict_Questions = CreateObject("Scripting.Dictionary")
> Dict_Questions.RemoveAll 'Clears dictionary object
> '---------------------------------------------------------
> ' Count total number of questions
> '---------------------------------------------------------
> QCnt_All = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("All
> Questions").Range("A1:A65000"))
> '---------------------------------------------------------
> ' Read number of questions/test required
> '---------------------------------------------------------
> QRequired = ThisWorkbook.Sheets("Make Test").Range("A1").Value
> '---------------------------------------------------------
> If QRequired > 0 Then
> While Dict_Questions.Count < QRequired
> '---------------------------------------------------------
> ' Select a random question from available questions
> '---------------------------------------------------------
> Qnum = Application.WorksheetFunction.RandBetween(2, QCnt_All)
> '---------------------------------------------------------
> ' If question has not been selected, then add to list
> '---------------------------------------------------------
> If (Not Dict_Questions.exists(Qnum)) Then
> Dict_Questions.Add Qnum, ThisWorkbook.Sheets("All
> Questions").Cells(Qnum, "B").Value
> End If
> Wend
> '---------------------------------------------------------
> ' Clear Test sheet and add selected questions
> '---------------------------------------------------------
> ThisWorkbook.Sheets("Test Questions").Range("A1:Z65000").ClearContents
> Qkeys = Dict_Questions.keys
> For I = 0 To Dict_Questions.Count - 1
> ThisWorkbook.Sheets("Test Questions").Cells(I + 1, "A").Value = I
> + 1
> ThisWorkbook.Sheets("Test Questions").Cells(I + 1, "B").Value =
> Dict_Questions.Item(Qkeys(I))
> Next
> End If
> End Sub
>
> ________________________________
> From: simoncg <simongall...@googlemail.com>
> To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
> Sent: Tuesday, October 27, 2009 11:12:32 AM
> Subject: $$Excel-Macros$$ New user VBA to help random sheet
>
> Hello,
>
> I am a teacher and use an excel document that makes tests drawn
> randomly from a bank of questions - there are a few list of questions
> and the test has q1 picking a random q from bank 1 etc. After a few
> questions it goes back and picks again from the first bank... The
> banks of questions are very long and so the chances of getting
> repeated questions are slim.
>
> However - I now need to work out a way of not picking the same
> question twice - I'm about to make new tests that will necessarily
> select from a smaller list of questions.
>
> Is there a way of using VBA to make this happen? If so could someone
> point me in the right direction? Any help much appreciated.
>
> Simon
--~--~---------~--~----~------------~-------~--~----~
----------------------------------------------------------------------------------
Some important links for excel users:
1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at
http://www.excelitems.com
2. Excel tutorials at http://www.excel-macros.blogspot.com
3. Learn VBA Macros at http://www.vbamacros.blogspot.com
4. Excel Tips and Tricks at http://exceldailytip.blogspot.com
To post to this group, send email to excel-macros@googlegroups.com
If you find any spam message in the group, please send an email to:
Ayush Jain @ jainayus...@gmail.com or
Ashish Jain @ 26may.1...@gmail.com
<><><><><><><><><><><><><><><><><><><><><><>
HELP US GROW !!
We reach over 6,500 subscribers worldwide and receive many nice notes about the
learning and support from the group. Our goal is to have 10,000 subscribers by
the end of 2009. Let friends and co-workers know they can subscribe to group at
http://groups.google.com/group/excel-macros/subscribe
-~----------~----~----~----~------~----~------~--~---
