This sub lets the user input a date & then proceeds to list all of the
Insert/Delete/Replace chnages that have been made a Microsoft Word Document
since that date.  However, this takes a long time to complete, even with
small documents & with large docs, it takes a prohibitive amount of time.  

The results are listed in a Word Document, with a tab printed in between the
"columns" (no table was used, as I found that using a table for the output
made this run even slower).

Does anyone know of a more effiicient way to tally up the differences?

Here's the code I have so far & thanks in advance!

Sub TrackByDate()
  Dim srcDoc As Document, destDoc As Document
  Dim oRev As Revision
  Dim strCkDate As String
  Dim ChangeTxt As String
  Dim FileName As String
  Dim CkDate As Date
  Dim RevType As Variant
  Dim nRows As Long
 
  RevType = Array("NoRevision", "Insert", "Delete", _
     "Property", "ParagraphNumber", "DisplayField", _
     "Reconcile", "Conflict", "Style", "Replace", _
     "ParagraphProperty", "TableProperty", _
     "SectionProperty", "StyleDefinition")

  strCkDate = InputBox$("Enter date (MM/DD/YYYY) to find all changes made
since:")
  If strCkDate = "" Then Exit Sub
  If Not IsDate(strCkDate) Then Exit Sub

  CkDate = CDate(strCkDate)

  Set srcDoc = ActiveDocument
  Set destDoc = Documents.Add
  destDoc.PageSetup.Orientation = wdOrientLandscape
 
  destDoc.Sections(1).Headers(wdHeaderFooterPrimary) _
       .Range.Text = "Revisions in " & srcDoc.FullName

  nRows = 1
 
  destDoc.Range.Text = "Revisions in " & _
     srcDoc.FullName & " since " & strCkDate & _
     vbCr & vbCr & "Date" & "     " & "     " & "Time" & "            " &
vbTab _
     & "Page" & vbTab & "Line" & vbTab & "Change" & vbTab & "Text" & vbCr &
vbCr

  For Each oRev In srcDoc.Revisions
   nRows = nRows + 1
 
   If CDate(Left$(Format(oRev.Date, "MM/DD/YYYY"), 10)) _
     >= CkDate Then
           
       If (RevType(oRev.Type) = "Insert" Or _
         RevType(oRev.Type) = "Delete" Or RevType(oRev.Type) = "Replace")
Then

           ChangeTxt = oRev.Range.Text
       
           ChangeTxt = Replace(ChangeTxt, vbCr, "  ")
           ChangeTxt = Replace(ChangeTxt, vbLf, "  ")
           ChangeTxt = Replace(ChangeTxt, vbCrLf, "  ")

           destDoc.Range.InsertAfter _
             oRev.Date & "     " & vbTab & _
             oRev.Range.Information(wdActiveEndAdjustedPageNumber) & vbTab
& _
             oRev.Range.Information(wdFirstCharacterLineNumber) & vbTab & _
           RevType(oRev.Type) & vbTab & "     " & ChangeTxt & vbCr

           End If
       End If
   Next oRev
End Sub