en dashes in VBA

J

JeremyC

Is there a way to get VBA to search for en dashes or em dashes? I can only
seem to get it to do hyphens. Even copying and pasting an en or em dash from
a Word document yields a hyphen. Thanks.
 
J

Jay Freedman

JeremyC said:
Is there a way to get VBA to search for en dashes or em dashes? I can
only seem to get it to do hyphens. Even copying and pasting an en or
em dash from a Word document yields a hyphen. Thanks.

Search for Chr$(150) for en dashes or Chr$(151) for em dashes.

More generally, see
http://word.mvps.org/FAQs/General/FindingSpecialCharacters.htm.

--
Regards,
Jay Freedman
Microsoft Word MVP
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
 
J

JeremyC

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.
 
J

Jay Freedman

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.
 
J

JeremyC

I am still having a bit of trouble with this VBA code. It seems that the
logic for double zero number ranges (e.g. 100-105, 200-211) don't seem to be
working correctly. I have tested the code and received the following results:

100-105 turns to 100-105 (correct)
100-110 turns to 100-10 (incorrect--should be 100-110)
200-4 turns to 200-4 (incorrect--should be 200-204)

I'm trying to decipher the code to see how I can adjust this, but thought I
would also check for help here. Thanks.

Jay Freedman said:
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.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top