Find most recent addition

[karl...@excite.com]

Using Word 97 with Track Changes enabled on a very long document, is
there a quick way to find the most recent addition or an addition made
on a known date?

Sorry if this double posted - can't find previous similar post

[Jay Freedman]

Here are two macros, one for each request. If you need instructions
for installing a macro in a template, see
http://www.gmayor.com/installing_macro.htm.

The first macro lists the revisions in the document by putting their
dates and page/line numbers in a table in a new document, and sorting
the table. The most recent revisions will be at the end of the table.
Word records the times only to the nearest minute, so there may be
several revisions shown as the same time and it may no be possible to
tell which one was made last.

Sub RevisionsByDateTime()
Dim srcDoc As Document, destDoc As Document
Dim oRev As Revision
Dim oTbl As Table
Dim nRows As Long

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

Set oTbl = destDoc.Tables.Add(Range:=destDoc.Range, _
numrows:=1, numcolumns:=3)
nRows = 1
With oTbl
.Cell(1, 1).Range.Text = "Date & Time"
.Cell(1, 2).Range.Text = "Page"
.Cell(1, 3).Range.Text = "Line"

For Each oRev In srcDoc.Revisions
.Rows.Add
nRows = nRows + 1
.Cell(nRows, 1).Range.Text = _
oRev.Date
.Cell(nRows, 2).Range.Text = oRev.Range.Information( _
wdActiveEndAdjustedPageNumber)
.Cell(nRows, 3).Range.Text = oRev.Range.Information( _
wdFirstCharacterLineNumber)
Next oRev

.Rows(1).HeadingFormat = True
.Sort excludeheader:=True, fieldnumber:=1, _
sortfieldtype:=wdSortFieldDate
End With
End Sub

The second macro lets you specify a date, and then lists the revisions
that were made on that date.

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

strCkDate = InputBox$("Enter date:")
If strCkDate = "" Then Exit Sub
If Not IsDate(strCkDate) Then Exit Sub

CkDate = CDate(strCkDate)

Set srcDoc = ActiveDocument
Set destDoc = Documents.Add
destDoc.Range.Text = "Revisions in " & _
srcDoc.FullName & " on " & strCkDate & _
vbCr & "Page" & vbTab & "Line" & vbCr & vbCr

For Each oRev In srcDoc.Revisions
If CDate(Left$(Format(oRev.Date, "MM/dd/yyyy"), 10)) _
= CkDate Then
destDoc.Range.InsertAfter _
oRev.Range.Information( _
wdActiveEndAdjustedPageNumber) & _
vbTab & oRev.Range.Information( _
wdFirstCharacterLineNumber) & _
vbTab & RevType(oRev.Type) & vbCr
End If
Next oRev
End Sub

--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org

[shivakum...@gmail.com]

Thanks Jay

Is it possible to have tow more columns added along with Page, line say What was the original Text and What is the final text.

[dpk...@gmail.com]

Not entirely what you're asking for but I find that the below gives me the additional info I require. Also note the two additional revision types.
Best displayed in a 'landscape' document...


Sub RevisionsByDateTime()
' source: https://groups.google.com/forum/?hl=en#!msg/microsoft.public.word.docmanagement/vexMtQlNj1M/A_oF4CbMiCEJ

Dim srcDoc As Document, destDoc As Document
Dim oRev As Revision
Dim oTbl As Table
Dim nRows As Long

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

RevType = Array("NoRevision", "Insert", "Delete", _
"Property", "ParagraphNumber", "DisplayField", _
"Reconcile", "Conflict", "Style", "Replace", _
"ParagraphProperty", "TableProperty", _

"SectionProperty", "StyleDefinition", "MovedFrom", "MovedTo")

Set oTbl = destDoc.Tables.Add(Range:=destDoc.Range, _

numrows:=1, numcolumns:=5)

nRows = 1
With oTbl
.Cell(1, 1).Range.Text = "Date & Time"

.Cell(1, 2).Range.Text = "Pg Ln"
.Cell(1, 3).Range.Text = "Author"
.Cell(1, 4).Range.Text = "Type"
.Cell(1, 5).Range.Text = "Text"

For Each oRev In srcDoc.Revisions
.Rows.Add
nRows = nRows + 1
.Cell(nRows, 1).Range.Text = _
oRev.Date
.Cell(nRows, 2).Range.Text = oRev.Range.Information( _

wdActiveEndAdjustedPageNumber) & " " & _
oRev.Range.Information(wdFirstCharacterLineNumber)
.Cell(nRows, 3).Range.Text = oRev.Author
.Cell(nRows, 4).Range.Text = RevType(oRev.Type)
.Cell(nRows, 5).Range.Text = oRev.Range.Text

[Kenny Soward]

Thanks! I actually used this successfully!