Generate Test Paper from Question Bank Using Excel VBA

Home More Excel (VBA) Training Videos








Josh wants to know how to Generate Test Paper from Question Bank Using Excel VBA. Here is his email:
'How can I create a question paper automatically in MS Excel?

I have a question bank of 110 questions in Excel and i would like  to create a test paper automatically. Every week I want to select 10 questions randomly from my collection of the 110 questions to create a test paper. No question should repeat in the test paper.

Josh'

In our VBA code we first generate a random number unsing the random function. Next using the countif function we ensure that the number generated is unique. If it's a duplicate we generate the number again till we have 10 unique numbers because we wish to get 10 questions from a question bank of 110 questions. Of course you can use our VBA code with as many questions as you have in your question bank and as many unique questions you wish to generate for your weekly or monthly or term test paper.
We assign these unique randomly generated numbers to get data from workshee2 into worksheet1 using the RowNum variable. So that the process of generating the test paper id fully automated we use a looping process with a 'for... next' loop.

You can use the code as is to create your own test paper. Just ensure that your question bank has the data in the same columns as in our example. Also take care that your sheets are named like our worksheets or change them accordingly.

Private Sub CommandButton1_Click()
'First we define two variables
Dim i, RowNum
'We clear all the content in column A
Sheets("Sheet1").Range("A:A").ClearContents
'We use the 'for next' loop to get our questions for the test paper. If you want 30 questions use i= 1 to 30
For i = 1 To 10

generate:
' we generate random integers. If you 2000 questions in your question bank use 2000 in the random function
RowNum = Application.RoundUp(Rnd() * 110, 0)
'This gets the number generated in column C
Cells(i, 3).Value = RowNum
' We want no duplicates so we check with countif
If Application.CountIf(Sheets("Sheet1").[A:A], Sheets("Sheet2").Cells(RowNum, "A")) = 0 Then
'if not duplicate we get the question from sheet2 to sheet1
Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Sheets("Sheet2").Cells(RowNum, "A").Value
Else
'if number generated is duplicate we generate another random number
GoTo generate
End If
Next i
' we do some formatting of the data in sheet1
Sheets("Sheet1").Select
Range("A1").Value = "Define the following terms in MS Excel"
Range("A1").Font.Bold = True
Range("A1").Columns.AutoFit
Range("B1").Select

End Sub



Watch the video on YouTube

Reference
Home More Excel (VBA) Training Videos