Creating 20 random combination of 10 numbers from 90 numbers

[ansridhar]

Hi

I am setting a question paper series for practice. Refer model sheet enclosed. I have 90 questions along a column in a sheet numbered 1 to 90 in the adjacent cell. Now, there are 10 groups of questions A to J. Each group has different numbers of questions. For example A has just 2 questions, serial no. 1 & 2, B has three questions, numbered 3 to 5, C has 20, D has 10, E has 16, F has 3, G has 7, H has 16, I has 9 and finally J group has 4 questions, all totaling to 90 questions. I want to evaluate a student in each group with a question. Thus, I want to create 20 random question papers (without any repeat question from C) but there has to be exactly one question only from each group. Can we do this in VBA?

 

[vletm]

ansridhar
You wrote Ask an Excel Question, but ...
... You wanted a VBA Macros - solution... too
Please, reread Forum Rules.
In this time, this thread has moved to correct Forum.

 

[Marc L]

Hi, according to the attachment a SSS Excel basics VBA demonstration to paste only to the Sheet1 worksheet module :​

Sub DemoSSS1()
    Dim C%, R%, N%, V(), W(), F%(), Ra As Range, D%, L%
        C = 6:  R = 1
    With UsedRange.Columns
            If .Count >= C Then .Item(C).Resize(, .Count - C + 1).Delete
            N = Application.CountA(.Item(1))
      ReDim V(1 To N, 1 To 2), W(2 To N), F(2 To N)
            V(1, 1) = .Cells(1)
        For Each Ra In .Item(1).SpecialCells(4).Areas
            D = Application.Max(D, Ra.Count + 1)
            R = R + 1
            V(R, 1) = Ra(0)
            W(R) = Ra(0, 3).Resize(Ra.Count + 1)
        Next
    End With
    For D = 1 To D
        V(1, 2) = "#" & D & "  " & [C1]
    For L = 2 To N
        F(L) = 1 - F(L) * (F(L) < UBound(W(L)))
        R = Application.RandBetween(F(L), UBound(W(L)))
        V(L, 2) = W(L)(R, 1):  W(L)(R, 1) = W(L)(F(L), 1):  W(L)(F(L), 1) = V(L, 2)
    Next
        Cells(C).Resize(N, 2).HorizontalAlignment = xlCenter
        Cells(C).Resize(N, 2) = V
        C = C + 3
    Next
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

 

[ansridhar]

Amazing Marc. Its almost 7 years now, when I used to write such codes. As I was out of touch, I had to approach the forum for help, where you have helped me nail this. Thanks

 

[p45cal]

Power Query table at cell G22.

 

[ansridhar]

Dear p45cal, you have given more than what I required. Meaning I am now thinking of using this in a different way for other subjects. Thanks a ton.

 

[ansridhar]

Dear p45cal, how I can include more groups, say 10 more, with varying numbers in each group and use the same sheet you sent. Could you send a modified sheet, (only if possible) with groups till T (A to T = 20) and each groups 5 each numbers within it.

 

[p45cal]

Add the new groups in the same way to the source table, ensuring the table extents are correct (drag the table bottom right grab handle if they're not):


then go to the results table, right-click somewhere in it and choose Refresh.

 

[ansridhar]

Great. Got it. Thanks a ton once again.

 

[ansridhar]

Hi, according to the attachment a SSS Excel basics VBA demonstration to paste only to the Sheet1 worksheet module :​

Sub DemoSSS1()
    Dim C%, R%, N%, V(), W(), F%(), Ra As Range, D%, L%
        C = 6:  R = 1
    With UsedRange.Columns
            If .Count >= C Then .Item(C).Resize(, .Count - C + 1).Delete
            N = Application.CountA(.Item(1))
      ReDim V(1 To N, 1 To 2), W(2 To N), F(2 To N)
            V(1, 1) = .Cells(1)
        For Each Ra In .Item(1).SpecialCells(4).Areas
            D = Application.Max(D, Ra.Count + 1)
            R = R + 1
            V(R, 1) = Ra(0)
            W(R) = Ra(0, 3).Resize(Ra.Count + 1)
        Next
    End With
    For D = 1 To D
        V(1, 2) = "#" & D & "  " & [C1]
    For L = 2 To N
        F(L) = 1 - F(L) * (F(L) < UBound(W(L)))
        R = Application.RandBetween(F(L), UBound(W(L)))
        V(L, 2) = W(L)(R, 1):  W(L)(R, 1) = W(L)(F(L), 1):  W(L)(F(L), 1) = V(L, 2)
    Next
        Cells(C).Resize(N, 2).HorizontalAlignment = xlCenter
        Cells(C).Resize(N, 2) = V
        C = C + 3
    Next
End Sub

Do you like it ? So thanks to click on bottom right Like !​

​

Hello. I am now trying to write a code for RANDOM creation of a question bank of 10 questions where there are 5 books, 11 or more chapters in each book, 5 types of questions in each chapter where numbers of questions is dependent on the size of the chapter. No question should be repeated and all questions should be selected at least once. I tried modifying the code sent way back in 2022 to my query, but I am unable to crack it. The details are written in sheet1

 

[Marc L]

You should elaborate the accurate rules to follow in order there is nothing to guess …​

​

 

[Marc L]

According to the post #10 attachment a starter VBA demonstration in order to fill cells I18 to L27 :​

Sub Demo1()
        Dim M&, oCol() As New Collection, R&, Q&, B&
   With [A1].CurrentRegion.Rows
        M = Application.Max(.Columns(1))
        ReDim oCol(1 To M)
        For R = 2 To .Count:  oCol(.Cells(R, 1)).Add R:  Next
    For Q = 1 To 10
        If Q <= M Then B = Q Else B = Application.RandBetween(1, M)
        R = Application.RandBetween(1, oCol(B).Count)
        Rows(17 + Q).Columns("I:L") = Application.Index(.Item(oCol(B)(R)), 1, [{1,3,4,5}])
        oCol(B).Remove R
    Next
   End With
        Erase oCol
End Sub

You may Like it !​

​

 

[ansridhar]

Thanks a lot Marc. I too tried a lot and got success albeit by modifying data arranagement. Meanwhile your reply came. Thanks again.