Microsoft Office Forums - View Single Post - [Solved] Changing 1,2,3,15 to 1-3,15

macropod · 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.