Sub ListExpandSortDeDupCompress()

Dim arrItems() As String
Dim OGList As String
Dim SplitList() As String
Dim FinalArray() As Variant
Dim Lease1 As String, Lease2 As String, InLease As Integer
Dim pos As Long

OGList = Selection.Text
OGList = Replace(OGList, " ", "")
SplitList = Split(OGList, ",")

  
Dim i As Integer
Dim j As Integer

For i = LBound(SplitList) To UBound(SplitList)
    If InStr(1, SplitList(i), "-") Then
        pos = CInt(InStr(1, SplitList(i), "-") - 1)
        Lease1 = Left(SplitList(i), pos)
        Lease2 = Right(SplitList(i), Len(SplitList(i)) - pos - 1)
        SplitList(i) = str(Lease1)
        For j = Lease1 + 1 To Lease2
            SplitList(i) = SplitList(i) & "," & str(j)
        Next j
    End If
Next i
  
  
OGList = Join(SplitList, ",")
OGList = Replace(OGList, " ", "")
'MsgBox (OGList)

SplitList = Split(OGList, ",")
Call BubbleSort(SplitList)
OGList = Join(SplitList, ",")
OGList = Replace(OGList, " ", "")
'MsgBox (OGList)

ReDim FinalArray(1 To 1) As Variant
For i = LBound(SplitList) + 1 To UBound(SplitList)
    If Not IsInArray(SplitList(i), FinalArray) Then
    FinalArray(UBound(FinalArray)) = SplitList(i)
    ReDim Preserve FinalArray(1 To UBound(FinalArray) + 1) As Variant
    End If
Next i

OGList = Join(FinalArray, ",")
OGList = Replace(OGList, " ", "")
MsgBox (OGList)



End Sub

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  IsInArray = UBound(Filter(arr, stringToBeFound)) > -1
End Function

Sub BubbleSort(arr)
    Dim i As Integer
    Dim j As Integer
    Dim itm As Variant
    Dim Lease1 As String, Lease2 As String, InLease As Integer
    Dim pos As Integer
    
    
    
    
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If InStr(1, arr(j), "-") Then
            pos = InStr(1, arr(j), "-") + 1
            Lease1 = CInt(Left(arr(j), pos))
            Lease2 = CInt(Right(arr(j), Len(arr(j)) - pos))
            End If
            
            If IsNumeric(arr(i)) And IsNumeric(arr(j)) Then
                If Val(arr(i)) > Val(arr(j)) Then
                    itm = arr(i)
                    arr(i) = arr(j)
                    arr(j) = itm
                End If
            ElseIf arr(i) > arr(j) Then
                itm = arr(i)
                arr(i) = arr(j)
                arr(j) = itm
        End If
        Next j
    Next i

End Sub