Hi Jeremy,
The first subroutine below does a Replace to change all the hyphens to en
dashes. The second routine calls the first one, and then does your logic on
the result. I changed it to use ranges exclusively and not touch the
Selection at all, which will speed up the macro noticeably.
Private Sub HyphenToEnDash(DocToChange As Document)
Dim oRg As Range
Set oRg = DocToChange.Range
With oRg.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "([0-9]{1,})-([0-9]{1,})"
' Chr$(150) is represented by ^0150
.Replacement.Text = "\1^0150\2"
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub
Public Sub CollapsePageRanges()
Dim oRg As Range, oRg1 As Range, oRg2 As Range
Dim source As Document
Dim target As Document
Dim nLen As Long
Set source = ActiveDocument
Set target = Documents.Add
HyphenToEnDash source ' convert to dashes
Set oRg = source.Range
With oRg.Find
.ClearFormatting
' Chr$(150) is represented by ^0150
.Text = "([0-9]{1,})^0150([0-9]{1,})"
.Forward = True
.Format = False
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute
Set oRg1 = oRg.Duplicate
Set oRg2 = oRg.Duplicate
oRg1.End = oRg1.Start + _
InStr(oRg1.Text, Chr$(150)) - 1
oRg2.Start = oRg2.Start + _
InStr(oRg2.Text, Chr$(150))
If (Len(oRg1.Text) = Len(oRg2.Text)) And _
(Left(oRg1.Text, 1) = Left(oRg2.Text, 1)) Then
If Mid$(oRg1.Text, 2, 1) = Mid$(oRg2.Text, 2, 1) Then
If Mid$(oRg1.Text, 2) <> "00" Then
target.Range.InsertAfter oRg.Text
oRg.Text = oRg1.Text & Chr$(150) _
& Mid$(oRg2.Text, 3)
target.Range.InsertAfter _
" was changed to " & oRg.Text & vbCr
End If
Else
target.Range.InsertAfter oRg.Text
oRg.Text = oRg1.Text & Chr$(150) & _
Mid$(oRg2.Text, 2)
target.Range.InsertAfter _
" was changed to " & oRg.Text & vbCr
End If
End If
oRg.Collapse wdCollapseEnd
Loop
End With
End Sub
One note: your logic doesn't scale to 4-digit page numbers. For example,
1030-1037 would be replaced by 1030-37. It has to do with the way you're
using fixed numbers of digits -- either 2 or 3 -- as the starting point in
the Mid() function calls. That may not be a problem for you if all your
citations are 3 digits or less.
--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
Thanks for the info. I'm still having trouble getting my macro to work
correctly (admittedly, I'm a bit of a VBA novice). Here is the code:
Sub PageRangeCorrection()
'
' test Macro
' Macro created 2/13/2006 by Jeremy Cunningham
'
Dim numrange As Range, numrange1 As Range, numrange2 As Range
Dim source As Document, target As Document
Set source = ActiveDocument
Set target = Documents.Add
source.Activate
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="[0-9]{1,}-[0-9]{1,}",
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set numrange = Selection.Range
Selection.Range.Collapse wdCollapseEnd
Set numrange1 = numrange.Duplicate
Set numrange2 = numrange.Duplicate
numrange1.End = numrange1.Start + InStr(numrange1, "-") - 1
numrange2.Start = numrange2.Start + InStr(numrange2, "-")
If Len(numrange1) = Len(numrange2) Then
If Left(numrange1, 1) = Left(numrange2, 1) Then
If Mid(numrange1, 2, 1) = Mid(numrange2, 2, 1) Then
If Mid(numrange1, 2) <> "00" Then
target.Range.InsertAfter numrange
numrange = numrange1 & "-" & Mid(numrange2, 3)
target.Range.InsertAfter " was changed to " & numrange & vbCr
End If
Else
target.Range.InsertAfter numrange
numrange = numrange1 & "-" & Mid(numrange2, 2)
target.Range.InsertAfter " was changed to " & numrange & vbCr
End If
End If
End If
Loop
End With
End Sub
I'm trying to get it to search for page range numbers like 160-165 and
change them to match the Chicago Manual of Style, i.e. 160-65. There
are a few exceptions. 100-109 (and any number in that range) should
not be changed. Numbers from 101-109 should be changed to 101-9, etc.
I would like to be able to search for page ranges with both hyphens
and en dashes separating the ranges, though if necessary I could run
a global find and replace for number strings with hypens to change to
en dashes. Then only an en dash search would be fine.
With this code, I can't seem to figure out how to get it to recognize
en dash strings. Thanks.