1) Sure. You just need to describe your logic.
For instance:
"choose # from bank 1 and # from bank 2"
OK, on the "Make Test" sheet, add a line for the number
from each "bank"
(A1 is # required from bank #1, A2 is # from bank #2)
Then, define QRequired1 and QRequired2
(Dim QRequired1, QRequired2)
then change/add:
QRequired1 = ThisWorkbook.Sheets("Make Test").Range("A1").Value
QRequired2 = ThisWorkbook.Sheets("Make Test").Range("A2").Value
You'll need to count the two lists of questions:
QCnt_All1 = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Bank
1").Range("A1:A65000"))
QCnt_All2 = Application.WorksheetFunction.CountA(ThisWorkbook.Sheets("Bank
2").Range("A1:A65000"))
Next, duplicate the loops: (notice I added "B1-" and "B2-" to the question
Number.
While Dict_Questions.Count < QRequired1
'---------------------------------------------------------
' Select a random question from available questions
'---------------------------------------------------------
Qnum = "B1-" & Application.WorksheetFunction.RandBetween(2, QCnt_All1)
'---------------------------------------------------------
' If question has not been selected, then add to list
'---------------------------------------------------------
If (Not Dict_Questions.exists(Qnum)) Then
Dict_Questions.Add Qnum, _
ThisWorkbook.Sheets("Bank 1").Cells(Qnum, "B").Value
End If
Wend
While Dict_Questions.Count < QRequired1 + QRequired2
'---------------------------------------------------------
' Select a random question from available questions
'---------------------------------------------------------
Qnum = "B2-" & Application.WorksheetFunction.RandBetween(2, QCnt_All2)
'---------------------------------------------------------
' If question has not been selected, then add to list
'---------------------------------------------------------
If (Not Dict_Questions.exists(Qnum)) Then
Dict_Questions.Add Qnum, _
ThisWorkbook.Sheets("Bank 2").Cells(Qnum, "B").Value
End If
Wend
There may be more to update, I'll have to test it.
=====================================================
2) Button or Auto_open: You can do it either way.
However, one scenario I used was to include the ANSWERS
in the file so that you can create an answer key
for easier grading! You wouldn't want to do that
it the student is the one opening the file!
If the "user" is a teacher, then it'll be ok.
3) Range of columns
Of course. Once again, you have to be able
to DESCRIBE what you want to do.
Let's say you want to put the questions into 4 columns.
You can:
The concept is that if you divide the question sequence
number by the number of columns, the REMAINDER will be
an indicator of the column number.
For instance, for 4 columns,
question 1 / 4 = 0 with 1 left over, so the column is 1
question 2 / 4 = 0 with 2 left over, so the column is 2
question 3 / 4 = 0 with 3 left over, so the column is 3
question 4 / 4 = 1 with 0 left over, here, you would want to 4
question 5 / 4 = 1 with 1 left over, so the column is 1
question 6 / 4 = 1 with 2 left over, so the column is 2
question 7 / 4 = 1 with 3 left over, so the column is 3
question 8 / 4 = 2 with 0 left over, here, you would want to 4
Now,
The function for this is MOD()
the row is another problem
The integer portion of Q1 / 4 is 0. so you can add an offset
for the header rows (say, begin in row 3)
as is Q2/4, Q3/4
but int(Q4/4) is 1, so you'll have to test to see if the
MOD() is 0...
So... I would:
Tcols = 4 '(Total columns)
Qkeys = Dict_Questions.keys
For I = 0 To Dict_Questions.Count - 1
C = mod((I + 1) / Tcols)
if (C = 0) then
C = Tcols
R = int( I + 1 / Tcols) + 2
else
R = int( I + 1 / Tcols) + 3
end if
R = int(I / Tcols) + 2
ThisWorkbook.Sheets("Test Questions").Cells(R, C).Value =
Dict_Questions.Item(Qkeys(I))
Next
If this is something you want to do, let me know and I can
test it more thoroughly.
Paul
________________________________
From: simoncg <simongall...@googlemail.com>
To: MS EXCEL AND VBA MACROS <excel-macros@googlegroups.com>
Sent: Wednesday, October 28, 2009 5:20:05 PM
Subject: $$Excel-Macros$$ Re: New user VBA to help random sheet
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
-~----------~----~----~----~------~----~------~--~---
