Changing 1,2,3,15 to 1-3,15

Cosmo · #1 08-04-2014, 01:15 PM

I have a document with a list of endnotes, and the client wants to consolidate the endnote numbers wherever they appear sequentially. My code already converts the endnotes to text (so that they don't get deleted when the numbers are removed), and now I need to consolidate the numbering, but I am not sure the best way to attack this.

To give an example, the following

This text has several endnotes 1,2,5,6,7,12
___________________
1 This is the first endnote
2 This is the second endnote
....etc.

Should result in

This text has several footnotes 1,2,5-7,12

The numbers will be a combination of endnotes and cross-references, but will be converted to text by the time this code runs.

Does anyone have any ideas to help get me started? Should I loop through the entire document one character at a time? Or maybe use a regex to find each pattern of numbers and commas and parse each result as a list and process?

Cosmo · #2 08-04-2014, 01:55 PM

I found this post which should hopefully help get me started with the formatting:
http://www.ozgrid.com/forum/showthread.php?t=72891

I still need to decide how best to find the text that needs to be converted.

macropod · #3 08-04-2014, 08:06 PM

The following function converts multiple sequences of 3 or more consecutive numbers in a list to a string consisting of the first & last numbers joined by a hyphen. The function includes some optional code to replace the final comma with, say, '&' or 'and'.

Code:

Function ParseNumSeq(StrNums As String, Optional StrEnd As String)
'This function converts multiple sequences of 3 or more consecutive numbers in a
' list to a string consisting of the first & last numbers separated by a hyphen.
Dim ArrTmp(), i As Integer, j As Integer, k As Integer
ReDim ArrTmp(UBound(Split(StrNums, ",")))
For i = 0 To UBound(Split(StrNums, ","))
  ArrTmp(i) = Split(StrNums, ",")(i)
Next
For i = 0 To UBound(ArrTmp) - 1
  If IsNumeric(ArrTmp(i)) Then
    k = 2
    For j = i + 2 To UBound(ArrTmp)
      If CInt(ArrTmp(i) + k) <> CInt(ArrTmp(j)) Then Exit For
      ArrTmp(j - 1) = ""
      k = k + 1
    Next
    i = j - 2
  End If
Next
StrNums = Join(ArrTmp, ",")
StrNums = Replace(Replace(Replace(StrNums, ",,", " "), ", ", " "), " ,", " ")
While InStr(StrNums, "  ")
  StrNums = Replace(StrNums, "  ", " ")
Wend
StrNums = Replace(Replace(StrNums, " ", "-"), ",", ", ")
If StrEnd <> "" Then
  i = InStrRev(StrNums, ",")
  If i > 0 Then
    StrNums = Left(StrNums, i - 1) & Replace(StrNums, ",", " " & Trim(StrEnd), i)
  End If
End If
ParseNumSeq = StrNums
End Function

The following macro demonstrates the function.

Code:

Sub Test()
Dim StrNums As String
StrNums = "1,2,3,4,5,7,8,9,11,13,14,15,16"
MsgBox ParseNumSeq(StrNums, "&")
End Sub

For your purposes, you could select the string to be converted and use something like:

Code:

Sub ParseNums()
With Selection
  .Text = ParseNumSeq(.Text, "&")
End With
End Sub

or you could use an InputBox, as in:

Code:

Sub Test()
Dim StrNums As String
StrNums = InputBox("Input the string, in the form of" & vbCr & _
"1,2,3,4,5,7,8,9,11,13,14,15,16" & vbCr & vbCr & vbCr & _
"For Example:", , "1,2,4,6,8,9,10,11")
MsgBox ParseNumSeq(StrNums)
MsgBox ParseNumSeq(StrNums, "&")
End Sub

You might, of course, want to add some error-checking to make sure only a comma-separated numeric string is processed.

Cosmo · #4 08-05-2014, 05:08 AM

Thanks, I'll check that over. I had converted the link I found, and it was mostly working, but I hadn't gotten it 100% working the way I want.

And there are at least 50 instances that need to be converted, and it will be run as part of a larger sequence, so selection is not an option. I am guessing that my best option would be running through each character of the document for a superscripted number, and continuing until I find a character that is not a number, space or comma (or is not superscripted), then processing that string.

macropod · #5 08-05-2014, 05:32 AM

Automating the process is as simple as calling the function with:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9][0-9,]{1,}"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    i = i + 1
    MsgBox .Text
    .Text = ParseNumSeq(.Text, "&")
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
MsgBox i & " sets updated."
End Sub

Note: all the output text will be in the same format as the first character (e.g. bold/superscript, etc.).

Cosmo · #6 08-05-2014, 06:30 AM

Thanks, I had just worked out a method which used a Find for the first superscripted number, then used moveEndWhile to get the full range, but I think that I migh like that route better. The full range should have the same formatting, so that shouldn't be a problem.

On the bright side, now I know about moveEndWhile.

Cosmo · #7 08-05-2014, 08:52 AM

Works excellently! Another part of this project gets checked off.

Thanks again for your help.

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
changing color	aerospace	Outlook	0	04-03-2013 05:56 AM
total slack not changing when changing duration	ketanco	Project	1	02-11-2012 07:23 AM
changing	gsrikanth	Excel Programming	8	02-08-2012 09:09 PM
Changing Word doc to .txt	cialili	Word	1	08-02-2010 12:38 PM
changing font size without changing leading	carolns	Word	1	09-14-2009 12:30 PM