title: Display glitch. Extra space after apostrophe when creating word documents VBA
body: <p>I have this VBA code that takes two documents (one original document and one revision document with blue text to be added) and creates a third document with the revisions.It mostly works, but when the third copy is created, there is extra space after apostrophes. It isn't actually an extra space though. Upon selecting the "Hidden Formatting" button in Word, it shows that there isn't actually a space at all. The character is just being displayed on the monitor incorrectly. I have tried a few things such as changing the font during the file creation and using the REPLACE function to no avail. This is not an isolated incident, <a href="http://answers.microsoft.com/en-us/mac/forum/macoffice2011-macword/why-does-word-2011-add-a-space-when-i-use/7e71bf0d-526f-4cfd-8764-4f44b327e18e" rel="nofollow">I found this documentation on the problem, unfortunately it does not pertain to VBA</a>. Looking for some ideas on how to fix the problem. </p>
  
  <pre><code>Sub WordReplaceSentence()
  
  MsgBox "Welcome to the word document automatic modifier", vbInformation + vbOKOnly
  
  MsgBox "Please open the revision file", vbInformation + vbOKOnly
  
      Dim strfilename1 As String
      Dim fd1 As Office.FileDialog
  
     ''''''Browsing/Opening the change request'''''''
  
      Set fd1 = Application.FileDialog(msoFileDialogFilePicker)
  
     With fd1
  
        .AllowMultiSelect = False
        .Title = "Open the modified word document."
        .Filters.Clear
        .Filters.Add "Word 2010", "*.docx"
        .Filters.Add "All Files", "*.*"
  
        If .Show = True Then
          strfilename1 = .SelectedItems(1) 'replace txtFileName with your textbox
        Else
        Exit Sub
        End If
     End With
  
  
  
  MsgBox "Open the orginal document", vbInformation + vbOKOnly
  
  
  Dim strfilename2 As String
  
      Dim fd2 As Office.FileDialog
  
      Set fd2 = Application.FileDialog(msoFileDialogFilePicker)
  
     With fd2
  
        .AllowMultiSelect = False
        .Title = "Please select the original file."
        .Filters.Clear
        .Filters.Add "Word 2010", "*.docx"
        .Filters.Add "All Files", "*.*"
  
        If .Show = True Then
          strfilename2 = .SelectedItems(1) 'replace txtFileName with your textbox
        Else
        Exit Sub
        End If
     End With
  
  
  MsgBox "Please enter the file name with which you want to store the new updated file", vbInformation + vbOKOnly
  
  
  ''''''''''''''''''Asking user to input name to the new revised document'''''''''''''''''''''''''''''''''''''
  
      Dim strfilename3 As String
  
      Dim fd3 As Office.FileDialog
  
      Set fd3 = Application.FileDialog(msoFileDialogSaveAs)
  
     With fd3
        .AllowMultiSelect = False
        .Title = "Please select the name to be given to the new file."
        If .Show = True Then
          strfilename3 = .SelectedItems(1) 'replace txtFileName with your textbox
        Else
        Exit Sub
        End If
     End With
  
  
  
      FileCopy strfilename2, strfilename3
  
      Set objWordChange = CreateObject("Word.Application")
      Set objWordorig = CreateObject("Word.Application")
  
      objWordChange.Visible = False
      objWordorig.Visible = False
  
      Set objDocChange = objWordChange.Documents.Open(strfilename1)
      Set objSelectionChange = objWordChange.Selection
      Set objDocOrig = objWordorig.Documents.Open(strfilename3)
      Set objSelectionOrig = objWordorig.Selection
  
      Dim rSearch As Range
      Dim dict As Scripting.Dictionary
      Dim i As Long
  
  
      'We'll store the sentences here
      Set dict = New Scripting.Dictionary
  
      Set rSearch = objDocChange.Range
      With rSearch
          .Find.Forward = True
          .Find.Format = True
          .Find.Font.Color = wdColorBlue
          .Find.Execute
  
          Do While .Find.Found
              'key = revised sentence, item = original sentence
              'if the revised sentence already exists in the dictionary, replace the found word in the entry
              If dict.Exists(.Sentences(1).Text) Then
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), Space(2), Space(1))
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " ,", ",")
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " .", ".")
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " '", "'")
                   For Each Key In dict
                          Debug.Print "KEY: " &amp; Key
                          Debug.Print "Item: " &amp; Item
                      Next
  
              Else
              'if the revised sentence isn't in the dict, then this is the first found word, so add it and replace the word
                  dict.Add .Sentences(1).Text, Replace$(Replace$(.Sentences(1).Text, .Text, vbNullString), Space(2), Space(1))
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " ,", ",")
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " .", ".")
                  dict.Item(.Sentences(1).Text) = Replace$(Replace$(dict.Item(.Sentences(1).Text), .Text, vbNullString), " '", "'")
              End If
              .Find.Execute
          Loop
      End With
  
      'Loop through all the dictionary entries and find the origial (item) and replace With
      'the revised (key)
      For i = 1 To dict.Count
          Set rSearch = objDocOrig.Range
          With rSearch.Find
              .MatchWholeWord = False
              .MatchCase = False
              .MatchPhrase = True
              .IgnoreSpace = True
              .IgnorePunct = True
              .Wrap = wdFindContinue
              .Text = dict.Items(i - 1)
              .Replacement.Text = dict.Keys(i - 1)
              .Execute Replace:=wdReplaceOne
  
          End With
          With objDocOrig.Range
              .Font.Name = "Calibri"
          End With
      Next i
  
  objDocChange.Close
  objDocOrig.Save
  objDocOrig.Close
  
  objWordChange.Quit
  objWordorig.Quit
  
  End Sub
  </code></pre>
  
  <p>If you need / want to test my code, you will have to create two word documents. Each document will need a common sentence containing an apostrophe (obviously). The second document would require a few blue words in addition to the original sentence in RGB 0,0,225.</p>