My kudos to
Larry Sulky for the below code. I personally asked Larry for help and he responded to me with grace and attitude well beyond expectation.
The code was designed to group a series of questions (multiple choice questions) with their answers. My original intention was to put the questions and the answer choices and explanations in two different word documents so we could combined them together in one file.
With this in mind, Larry developed this amazing code to be used with just one file.
The intention was to have all the questions (the test file has 169 questions) listed all the way to the end of the file (questions with the a, b, c, and d option).
After all the questions were listed we add it all the answer explanations to all the questions, and the format of the answer explanation was as follow:
168. (a) The requirement is to identify the correct statement with respect to the primary orientation of operational auditing
Based on this, Larry Sulky, with his amazing code was able to come out with a solution to my request, and here is how the output looks now.
=================================================
168. Operational auditing is primarily oriented toward
a. Future improvements to accomplish the goals of management.
b. The accuracy of data reflected in management’s financial records.
c. The verification that a company’s financial statements are fairly presented.
d. Past protection provided by existing internal control.
Answer: A
168. (a) The requirement is to identify the correct statement with respect to the primary orientation of operational auditing
================================================== =
If the code is not listed in the appropriate format, please accept my apologies. Try to followed Macropod advise, but can't get to find it.
Cheers!
Code:
Sub CollateQandA()
' Initialise common Find/Replace parameters.
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
' Ensure that there is a final dummy "question" by finding the first real answer
' and inserting a dummy there.
Selection.HomeKey Unit:=wdStory
With Selection.Find
.Text = "[^013^l][0-9]@.[^s ]@[(][a-z]@[)]"
.Replacement.Text = ""
.Forward = True
End With
If Not Selection.Find.Execute Then Goto Finish
Selection.HomeKey Unit:=wdLine
Selection.TypeParagraph
Selection.TypeText ("0000. PLACEHOLDER QUESTION.")
' Ensure that there is a final dummy "answer".
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeText ("0000. (z) PLACEHOLDER ANSWER.")
' Ensure that there is a hard return before the first line of text.
Selection.HomeKey Unit:=wdStory
Selection.TypeParagraph
Do
Dim myNumberStart As Integer
Dim myNumberStop As Integer
Dim myNumber As String
Dim myLetterStart As Integer
Dim myLetterStop As Integer
Dim myLetter As String
' Hard returns and line breaks seem to be used interchangeably, so look for both.
' Also look for space or non-breaking space.
' Find the next correct answer.
With Selection.Find
.Text = "[^013^l][0-9]@.[^s ]@[(][a-z]@[)]"
.Replacement.Text = ""
.Forward = True
End With
If Not Selection.Find.Execute Then Goto Finish
' Get the number and letter of the answer.
myNumberStart = 2
myNumberStop = InStr(1, Selection.Text, ".")
myLetterStart = InStr(1, Selection.Text, "(") + 1
myLetterStop = InStr(1, Selection.Text, ")")
myNumber = Mid(Selection.Text, myNumberStart, myNumberStop - myNumberStart)
myLetter = UCase(Mid(Selection.Text, myLetterStart, myLetterStop - myLetterStart))
' Get the whole answer and cut it.
Selection.Collapse direction:=wdCollapseStart
With Selection.Find
.Text = "[!^013^l]@[^013^l]"
.Replacement.Text = ""
.Forward = True
End With
If Not Selection.Find.Execute Then Goto Finish
Selection.Cut
' Find the matching question.
With Selection.Find
.Text = "[^013^l]" & myNumber & "."
.Replacement.Text = ""
.Forward = False
End With
If Not Selection.Find.Execute Then
' If no match, mark the answer as "UNMATCHED" and paste it at the bottom.
'MsgBox "Missing question #" & myNumber & ".", , "Uh-oh"
Selection.EndKey Unit:=wdStory
Selection.TypeParagraph
Selection.TypeText "UNMATCHED "
Selection.Paste
Selection.HomeKey Unit:=wdStory ' Go back to the top to find the next answer.
Goto EndLoop ' Skip the rest of the loop processing, since we have no match.
End If
' Find the NEXT question, which marks the end of the CURRENT question.
Selection.Collapse direction:=wdCollapseEnd
With Selection.Find
.Text = "[^013^l][0-9]@."
.Replacement.Text = ""
.Forward = True
End With
If Not Selection.Find.Execute Then Goto Finish
' Insert the Answer marker and paste the actual answer.
Selection.Collapse direction:=wdCollapseStart
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.TypeText ("Answer: " & myLetter)
Selection.TypeText Text:=Chr(11) ' Insert a line break, since that seems to be preferred.
Selection.TypeText "MATCHED "
Selection.Paste
EndLoop:
Loop
Finish:
Selection.HomeKey Unit:=wdStory
'''Selection.Delete Unit:=wdCharacter, Count:=1
With Selection.Find
.Text = "[^013^l]MATCHED "
.Replacement.Text = "^l"
.Forward = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "0000. (z) PLACEHOLDER ANSWER."
.Replacement.Text = ""
.Forward = True
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Delete Unit:=wdCharacter, Count:=1
With Selection.Find
.Text = "0000. PLACEHOLDER QUESTION."
.Replacement.Text = ""
.Forward = True
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
'''Selection.Delete Unit:=wdCharacter, Count:=1
Selection.HomeKey Unit:=wdStory
Bye: ' Just for debug purposes.
End Sub