0

Given an array of numbers:

[1,3,4,5,8,9,11]

What's the simplest way in VBA to convert that list to a readable string, e.g:

1, 3-5, 8-9, 11

I could just rewrite my VB.net function to VBA but it's already quite long winded and it will end up even longer in VBA.

Public Shared Function GroupedNumbers(nums As List(Of Long))

    If nums Is Nothing OrElse nums.Count = 0 Then Return "-"

    If nums.Count = 1 Then Return nums(0)

    Dim lNums = nums.Distinct().OrderBy(Function(m) m).ToList

    Dim curPos As Long = 1
    Dim lastNum As Long = lNums(0)
    Dim i As Long = 0
    Dim numStr As String = lNums(0)
    Dim isGap As Boolean = False

    Do Until i >= lNums.Count - 1
        Do Until i >= lNums.Count - 1 OrElse lNums(i) + 1 <> lNums(i + 1)
            i += 1
            isGap = True
        Loop
        If isGap Then
            numStr += "-" & lNums(i)
        End If
        If i <> lNums.Count - 1 Then
            numStr += ", " & lNums(i + 1)
            isGap = False
            i += 1
        End If
    Loop

    Return numStr

End Function

Just wondering if anyone has a better way of doing this before i go about rewriting it for VBA?

3 Answers3

0

Well i took the long route:

Public Sub SortCollection(ByRef c As Collection)
Dim tmp
For i = 1 To c.Count - 1
    For j = i + 1 To c.Count
        If c(i) > c(j) Then
           vTemp = c(j)
           c.Remove j
           c.Add tmp, tmp, i
        End If
    Next j
Next i
End Sub


Public Function NumberListGrouped(cells As Range) As String

    If cells.Count = 0 Then
        AnimalIdListGrouped = "-"
    ElseIf cells.Count = 1 Then
        AnimalIdListGrouped = cells(1, 1)
    End If

    Dim c As New Collection

    On Error Resume Next
    For Each cell In cells
        c.Add CInt(cell.Value), CStr(cell.Value)
    Next cell
    SortCollection c
    On Error GoTo 0

    Dim i As Long: i = 1
    Dim numStr As String: numStr = c(1)
    Dim isGap As Boolean: isGap = False

    Do Until i >= c.Count
        DoEvents
        Do Until i >= c.Count Or c(i) + 1 <> c(i + 1)
            i = i + 1
            isGap = True
            DoEvents
        Loop
        If isGap Then
            numStr = numStr & "-" & c(i)
        End If
        If i <> c.Count Then
            numStr = numStr & ", " & c(i + 1)
            isGap = False
            i = i + 1
        End If
    Loop

    NumberListGrouped = numStr

End Function
0

If you want a simple method, you might use something like the following:

Function GroupedNumbers(nums() As Long) As String
    SortMe (nums) 'No built-in sort method in VBA,
                  'so you need to implement one yourself (see links below).
    Dim numStr As String
    numStr = nums(0)
    For i = 1 To UBound(nums)
        If nums(i) = nums(i - 1) + 1 Then
            numStr = numStr & IIf(nums(i) + 1 = nums(i + 1), "", "-" & nums(i))
        Else
            numStr = numStr & ", " & nums(i)
        End If
    Next i
    GroupedNumbers = numStr
End Function

For array sorting you might refer to this question.

And if you want something more simple, check this answer which use the .NET version of ArrayList for sorting. Hence you would need to adapt the above function to work with ArrayList instead of Array.

Hope that helps :)

Community
  • 1
  • 1
  • That was a bit shorter than mine, but i had to make some changes to it as i was passing in a collection just for uniqueness and that fell over when i tried to test the last number against one higher. –  Sep 07 '16 at 15:47
0

Should you ever use VBA in Excel, you could have it do the work for you as follows

Function GroupedNumbers(nums() As Long) As String
    Dim strng As String
    Dim i As Long

    For i = LBound(nums) To UBound(nums) - 1
        strng = strng & CStr(nums(i)) & ",A"
    Next i
    strng = "A" & strng & CStr(nums(i))
    GroupedNumbers = Replace(Replace(Replace(Intersect(Columns(1), Range(strng)).Address(False, False), ",A", ", "), "A", ""), ":", "-")
End Function
user3598756
  • 28,893
  • 4
  • 18
  • 28