Word elision macro

Question

Someone in the community very kindly put together the following macro for me:

Elision macro

Sub Elision ()

Application.ScreenUpdating = False

Dim StrA As String, StrB As String, i As Long, j As Long

With ActiveDocument.Range

  With .Find

    .ClearFormatting

    .Replacement.ClearFormatting

    .Text = "<[0-9]{2,}-[0-9]{2,}>"

    .Replacement.Text = ""

    .Wrap = wdFindStop

    .MatchWildcards = True

    .Forward = False

    .Execute

  End With

  Do While .Find.Found

    StrA = Split(.Text, "-")(0)

    StrB = Split(.Text, "-")(1)

    If Len(StrA) = Len(StrB) Then

      For i = 1 To Len(StrA)

        If Left(StrA, i) <> Left(StrB, i) Then

          StrB = Right(StrB, Len(StrB) + 1 - i)

          Exit For

        End If

      Next

    ElseIf Len(StrA) > Len(StrB) Then

      j = Len(StrA) - Len(StrB)

      For i = 1 To Len(StrB)

        If Mid(StrA, j + i, i) <> Left(StrB, i) Then

          StrB = Right(StrB, Len(StrB) + 1 - i)

          Exit For

        End If

      Next

    End If

    .MoveStart wdCharacter, Len(StrA) + 1

    .Text = StrB

    .Collapse wdCollapseStart

    .Find.Execute

  Loop

End With

Application.ScreenUpdating = True

End Sub

This turns number spans like the following:

128-134

66-68

1340-346

350-359

126–29

into 

128-34

66-8

1340-46

350-9

126-9

Would it be possible to tweak this so that it works for both en dashes in spans as well as hyphens, and changes hyphens into en dashes? Also, so that it highlights all results so that I can double check them. Finally, to make 1340-346 change to 1340-6?

If anyone of you out there can help, I'd be immensely grateful.

Thanks in anticipation

Nick

Answer 1

My fault, sorry for the inconvenience.

I started with:

128-134

66-68

1340-346

350-359

126–29

And end up:

128–34

66–8

1340–6

350–9

126–9

As you have requested, use the following code.

Sub Elision_AK()
  Dim StrA As String, StrB As String, i As Long, j As Long
  Dim Delimiter As Variant
  Dim Pattern
  'Hypen, en dash
  Delimiter = Array("-", ChrW(8211))
  Pattern = "[" & Join(Delimiter, "") & "]"
  With ActiveDocument.Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "<[0-9]{2,}" & Pattern & "[0-9]{2,}>"
      .Replacement.Text = ""
      .Wrap = wdFindStop
      .MatchWildcards = True
      .Forward = False
      .Execute
    End With
    Do While .Find.Found
      For j = 0 To UBound(Delimiter)
        If InStr(.Text, Delimiter(j)) > 0 Then
          StrA = Split(.Text, Delimiter(j))(0)
          StrB = Split(.Text, Delimiter(j))(1)
          Exit For
        End If
      Next
      For i = 1 To Len(StrB)
        If InStr(1, StrA, Left(StrB, i)) = 0 Then Exit For
      Next
      If i > 1 Then
        StrB = Mid(StrB, i)
        .Select
        DoEvents
        Select Case MsgBox("Replace with " & StrA & "-" & StrB & "?", vbYesNoCancel + vbQuestion, "Elision_AK")
          Case vbNo
            GoTo Skip
          Case vbCancel
            Exit Sub
        End Select
        .MoveStart wdCharacter, Len(StrA)
        .Text = ChrW(8211) & StrB
      End If
Skip:
      .Collapse wdCollapseStart
      .Find.Execute
    Loop
  End With
End Sub

Answer 2

IMHO there is no way to highlight all.

In VBA we need the Range object to call the Select method to highlight a text.

But the Range object in the VBA object model supports only one start and end position.

https://msdn.microsoft.com/en-us/vba/word-vba/a...

And there is no way to combine 2 (or more) Range objects in Word (don't get confused with UNION of Excel which can do that, but UNION doesn't exist in Word).

It is possible to create a Userform (a separate window) and show a list with all occurrences (similar as the "Find All" feature in Excel), but that is expensive, because such a tool must be placed in an AddIn.

Answer 3

The macro "asks" (shows a message box) because that is the only way for a macro to let the user (you) choose to replace the related part or not.

It is not possible to highlight all occurrences and let you double click afterwards to perform the change.

Answer 4

Thanks for this, Andreas. It didn't quite seem to work, producing instead the following (with no highlighting):

128-134

66-68

1340-46

350-9

126–29

There was also a box when the macro finished, asking if I wanted to replace 1340-46 with 1340-6, then if I wanted to replace 66-68 with 66-8, then if I wanted to replace 128-134 with 128-34 and finally if I wanted to replace 126-29 with 126-9.

No hyphens were changed to en dashes.

I guess it still needs a few tweaks, but it's close.

Thanks again.

Answer 5

Try the code below.

Sub Elision_AK()
  Dim StrA As String, StrB As String, i As Long, j As Long
  Dim Delimiter As Variant
  'Hypen, en dash, em dash
  Delimiter = Array("-", ChrW(8211), ChrW(8212))
  For j = 0 To UBound(Delimiter)
    Application.StatusBar = "Searching for " & Delimiter(j)
    With ActiveDocument.Range
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<[0-9]{2,}" & Delimiter(j) & "[0-9]{2,}>"
        .Replacement.Text = ""
        .Wrap = wdFindStop
        .MatchWildcards = True
        .Forward = False
        .Execute
      End With
      Do While .Find.Found
        StrA = Split(.Text, Delimiter(j))(0)
        StrB = Split(.Text, Delimiter(j))(1)
        For i = 1 To Len(StrB)
          If InStr(1, StrA, Left(StrB, i)) = 0 Then Exit For
        Next
        If i > 1 Then
          StrB = Mid(StrB, i)
          .Select
          DoEvents
          If MsgBox("Replace with " & StrA & "-" & StrB & "?", vbOKCancel + vbQuestion, "Elision_AK") = vbCancel Then Exit Sub
          .MoveStart wdCharacter, Len(StrA) + 1
          .Text = StrB
        End If
        .Collapse wdCollapseStart
        .Find.Execute
      Loop
    End With
  Next
  Application.StatusBar = ""
End Sub