Word 2010 BA to shuffle numbered lists

Question

I am trying to shuffle the items in a numbered list in MS Word 2010. The background for this question is that my wife is an English teacher who makes her tests using Word. Whenever she makes a test she also makes a second version by changing the order of the items in the numbered lists.

I am looking to either:

• change the order of items in a numbered list that I select using the mouse, ie select the numbered list, push a button/shortcut and the list is shuffled or
• change the order of all numbered lists in the test, ie the macro looks for the start of a new numbered list, selects all items in the list, changes the order of the items and then moves over to the next numbered list.

All lists should keep the same formatting (ie start number) after using the code.

I tried for the first instance but did not succeed in determining the start and end line numbers of my selection.

Example:

Original:

===== Start: ========

Question 1 What answer is correct?

1. Answer A
2. Answer B
3. Answer C

Question 2 What answer is correct?

1. Answer D
2. Answer E
3. Answer F

Question 3 What answer is correct?

1. Answer G
2. Answer H
3. Answer J

======End========

The macro should create this:

======Start========

Question 1 What answer is correct?

1. Answer C
2. Answer A
3. Answer B

Question 2 What answer is correct?

1. Answer F
2. Answer E
3. Answer D

Question 3 What answer is correct?

1. Answer H
2. Answer J
3. Answer G

====End======

Answer 1

Since you are dealing with only 3 list items, it is pretty easy. Just swap any of the two items. The following code does the same.

For more than 3 items, you may have to repeat the logic of swapping more rows. But you should get the basic idea about how to go about it from this code.

Sub Shuffle()
    Dim li As List, rng As Range, random As Integer

    Randomize
    For Each li In ThisDocument.Lists
        ' get either 1 or 2. We will swap this with the 3rd item
        random = CInt(Rnd + 1)

        ' add a new paragraph as temporary place holder. This is so that we can keep the paragraph with its formatting intact.
        Set rng = li.Range.Paragraphs.Add.Range
        rng.FormattedText = li.Range.Paragraphs(random).Range.FormattedText

        ' swap the items
        li.Range.Paragraphs(random).Range.FormattedText = li.Range.Paragraphs(3).Range.FormattedText
        li.Range.Paragraphs(3).Range.FormattedText = rng.FormattedText

        ' remove the temporary paragraph we added
        li.Range.Paragraphs.Last.Range.Delete
    Next
End Sub

Answer 2

I slightly modified the code by Pradeep Kumar and this works like a charm, even with an unknown number of items per numbered list and so that it can be incorporated in the normal.dot template:

Sub Shuffle()

Dim li As List, rng As Range, random As Integer, nbr As Integer
Application.ScreenUpdating = False
Randomize
For Each li In ActiveDocument.Lists
    nbr = li.CountNumberedItems
    ' Run along all items in list and swap with a random one from the same list
    For a_counter = 1 To nbr
        ' Make sure the item is not swapped with itself, that would fail    
        again:
            random = CInt((nbr - 1) * Rnd + 1)
        If random = a_counter Then GoTo again

        ' add a new paragraph as temporary place holder. This is so that we can keep the paragraph with its formatting intact.
        Set rng = li.Range.Paragraphs.Add.Range
        rng.FormattedText = li.Range.Paragraphs(random).Range.FormattedText

        ' swap the items
        li.Range.Paragraphs(random).Range.FormattedText = li.Range.Paragraphs(a_counter).Range.FormattedText
        li.Range.Paragraphs(a_counter).Range.FormattedText = li.Range.Paragraphs(nbr + 1).Range.FormattedText

        ' remove the temporary paragraph we added
        li.Range.Paragraphs(nbr + 1).Range.Delete
    Next a_counter
Next
Application.ScreenUpdating = True
End Sub