Is possible to shuffle answers in multiple choice test in EXCEL?

[t0m1noo]

I have a lot of questions and I need to quickly shuffle answers in Multiple Choice Test. (1 question has 4 answers, A,B,C, or D).
For example:

Is possible to do that by using VBA or with some formula?

Thanks for the help.

 

[Peter_SSs]

there were also questions in column C

With questions in every second column (A & C or A, C, E, G, ...) and blank columns between, try this with a copy of your data.
I have assumed that each question starts with a number in parentheses like your samples.

Sub Shuffle()
  Dim c As Long
 
  For c = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
    With Range(Cells(1, c), Cells(Rows.Count, c).End(xlUp)).Resize(, 2)
      .Columns(2).Formula = "=COUNTIF(C$1:C1,""(*"")+IF(left(C1,1)=""("",0,rand())"
      .Sort Key1:=.Columns(2), Order1:=xlAscending, Header:=xlNo
      .Columns(2).ClearContents
    End With
  Next c
End Sub

 

[t0m1noo]

Try the below macro considering you only have 4 answers per question & they're in column A and shuffled questions will be pasted in column C with the same format you've posted in the attached picture in post #1

Sub ShuffleQuestions()

Dim a As Variant, b As Variant, Ans(1 To 4) As String, Coll As New Collection
a = ActiveSheet.Range("A1").CurrentRegion

ReDim b(1 To UBound(a))
For x = LBound(a) To UBound(a)
    If a(x, 1) Like "*uestion*" Then
        b(x) = a(x, 1)
    ElseIf a(x, 1) Like "a)*" Then
        For y = 0 To 3
            Coll.Add y + 1
            Ans(y + 1) = a(x + y, 1)
        Next
        For y = 0 To 3
            j = WorksheetFunction.RandBetween(1, Coll.Count)
            b(x + y) = Ans(Coll(j))
            Coll.Remove j
        Next
    End If
Next x

ActiveSheet.Range("C1").Resize(UBound(b)) = Application.Transpose(b)

End Sub

With this VBA code, it looks like this:

And I need in order to looks like this:

Is it possible?

 

[mse330]

Yes, try the below revised code

Sub ShuffleQuestions()

Dim a As Variant, b As Variant, Ans(1 To 4) As String, Coll As New Collection
a = ActiveSheet.Range("A1").CurrentRegion

ReDim b(1 To UBound(a))
For x = LBound(a) To UBound(a)
    If Left(a(x, 1), 1) = "(" Then
        b(x) = a(x, 1)
    ElseIf LCase(a(x, 1)) Like "a)*" Then
        For y = 0 To 3
            Coll.Add y + 1
            Ans(y + 1) = a(x + y, 1)
        Next
        For y = 0 To 3
            j = WorksheetFunction.RandBetween(1, Coll.Count)
            b(x + y) = Ans(Coll(j))
            Coll.Remove j
        Next
    End If
Next x

ActiveSheet.Range("C1").Resize(UBound(b)) = Application.Transpose(b)

End Sub

 

[Peter_SSs]

And I need in order to looks like this:
View attachment 11728

Is it possible?

In post #9 you said there were also questions in column C so it seems strange to now be wanting to move questions from column A to column C.

 

[Peter_SSs]

.. but if you do want to move the column A questions to column C with shuffled answers, try this

Sub Shuffle_v2()
  Columns("A").Copy Destination:=Range("C1")
  With Range("C1:D" & Range("C" & Rows.Count).End(xlUp).Row)
    .Columns(2).Formula = "=COUNTIF(C$1:C1,""(*"")+IF(left(C1,1)=""("",0,rand())"
    .Sort Key1:=.Columns(2), Order1:=xlAscending, Header:=xlNo
    .Columns(2).ClearContents
  End With
End Sub

My sample data and results

t0m1noo 2020-04-18 1.xlsm
	A	B	C
1	(1.) Question		(1.) Question
2	a correct		a correct
3	b false		d false
4	c correct		b false
5	d false		c correct
6	(2.) Something else		(2.) Something else
7	a false		d false
8	b correct		a false
9	c false		c false
10	d false		b correct
11	(3.) Another one		(3.) Another one
12	a correct		d correct
13	b correct		c false
14	c false		b correct
15	d correct		a correct
Sheet1

 

[GraH]

Also Possible with a Power Query script

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Questions", type text}}),
    #"Added Custom" = Table.AddColumn(#"Changed Type", "Question", each if Text.Start([Questions],1)="(" then [Questions] else null),
    #"Added Custom1" = Table.AddColumn(#"Added Custom", "Answers MC", each if [Question] = null then [Questions] else null),
    #"Filled Down" = Table.FillDown(#"Added Custom1",{"Question"}),
    #"Filtered Rows" = Table.SelectRows(#"Filled Down", each ([Answers MC] <> null)),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Questions"}),
    #"Added Custom2" = Table.AddColumn(#"Removed Columns", "Custom", each Number.Random()),
    #"Added Index1" = Table.AddIndexColumn(#"Added Custom2", "Index.1", 1, 1),
    #"Sorted Rows" = Table.Sort(#"Added Index1",{{"Question", Order.Ascending}, {"Custom", Order.Ascending}}),
    #"Removed Columns1" = Table.RemoveColumns(#"Sorted Rows",{"Custom", "Index.1"})
in
    #"Removed Columns1"

At each refresh the answers are shuffled.
- Original data

- Results of PQ (refresh)

I forgot about sorting the questions from 1-500, but that's also do-able.

 

[GraH]

Improved PQ, sorting Questions in original order.

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Questions", type text}}),
    GetQuestion = Table.AddColumn(#"Changed Type", "Question", each if Text.Start([Questions],1)="(" then [Questions] else null),
    GetAnswers = Table.AddColumn(GetQuestion, "Answers MC", each if [Question] = null then [Questions] else null),
    FillDownQuestions = Table.FillDown(GetAnswers,{"Question"}),
    FilterOutNulls = Table.SelectRows(FillDownQuestions, each ([Answers MC] <> null)),
    GroupByQuestion_AllRows = Table.Group(FilterOutNulls, {"Question"}, {{"All", each _, type table [Questions=text, Question=text, Answers MC=text]}}),
    AddIndexForGroup = Table.AddIndexColumn(GroupByQuestion_AllRows, "Index", 1, 1),
    ExpandAll_AnswersMC = Table.ExpandTableColumn(AddIndexForGroup, "All", {"Answers MC"}, {"Answers MC"}),
    AddRandom = Table.AddColumn(ExpandAll_AnswersMC, "Random", each Number.Random()),
    AddIndex = Table.AddIndexColumn(AddRandom, "Index.1", 1, 1),
    SortOnIndex_Random = Table.Sort(AddIndex,{{"Index", Order.Ascending}, {"Random", Order.Ascending}}),
    RemoveHelperColumns = Table.RemoveColumns(SortOnIndex_Random,{"Random", "Index", "Index.1"})
in
    RemoveHelperColumns

 

[t0m1noo]

Thank you all for your ideas and solutions!

 

[t0m1noo]

Is possible to extract only numbers of questions like you can see in the picture:

 

[mse330]

Again, if you need to change the location of the pasted data you can just change the last line of the code

Sub GetNumbers()
    a = Range("A1").CurrentRegion: ReDim b(1 To UBound(a))
        For x = 1 To UBound(a)
            If a(x, 1) Like "(#*" Then c = c + 1: b(c) = Mid(Split(a(x, 1), ".")(0), 2)
        Next
    Range("C1").Resize(c) = Application.Transpose(b)
End Sub