Option Explicit
Sub Convert_To_Respondus()
'
' Convert ExamSoft RTF to Respondus RTF
'
'Format entire document to Calibri 12pt
    Selection.WholeStory
    Selection.Font.Name = "Calibri"
    Selection.Font.Size = 12
    
' Replace 'Question#: XXX' with XXX)
    With Selection.Find
        .Text = "Question #: ([0-9])([0-9])([0-9])"
        .Replacement.Text = "\1\2\3)"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Replace 'Question#: XX' with XX.
     With Selection.Find
        .Text = "Question #: ([0-9])([0-9])"
        .Replacement.Text = "\1\2)"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

' Replace 'Question#: X' with X.
        With Selection.Find
        .Text = "Question #: ([0-9])"
        .Replacement.Text = "\1)"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'Replace 'Item Weight:' with 'Points'
    With Selection.Find
        .Text = "Item Weight:"
        .Replacement.Text = "Points:"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'Replace checkmark with '*'
    With Selection.Find
        .Text = ChrW(10003)
        .Replacement.Text = "*"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting

'Remove line between questions
    With Selection.Find
        .Text = _
            "____________________________________________________________________________"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
    End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
'Remove extra whitespace
     With Selection.Find
        .Text = "^p^p^p"
        .Replacement.Text = "^p"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

'Remove extra whitespace betweem question number and question stem
    With Selection.Find
        .Text = ")^p^p"
        .Replacement.Text = ") "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
    
'Move to top of the document and insert the point value for each question
    Selection.MoveUp Unit:=wdScreen, Count:=50
    Selection.TypeText Text:="Points: XXX"
End Sub