Solved

# Sorting numbers within an Excel cell

Posted on 2012-09-21
382 Views
Hi, I have ranges of numbers in a column of cells, eg
Cell 1 - 13, 14, 15, 13, 11-12, 14, 54, 14, 49, 12, 14, 23, 28-29, 29, 107, 13-14, 15, 18, 54, 14, 25-29, 10, 15, 20, 29
Cell 2 - 12, 28, 44, 44, 59, 60, 61, 61, 42, 58
Some are separated by commas and others are number ranges. I would like to sort the numbers within the ranges and if possible at the same time remove any duplicates.
Any assistance would be much appreciated.
Many thanks
0
Question by:LetsLearn

LVL 11

Expert Comment

For clarity, what would be the expected results for the above examples, LetsLearn?
0

Author Comment

Ideal solution would be:

Cell 1: 10, 11-12, 13, 14, 15, 18, 20, 23, 25-29, 49, 54, 107
Cell2: 2, 28, 42, 44, 58, 59, 60, 61

But not sure if it is possible?
0

LVL 11

Expert Comment

And now we wait...
(for some Excel guru who know's what (s)he's doing)
0

LVL 44

Expert Comment

1. What would you want in Cell 1 if the first value range was "1 - 12" rather that "! - 13"?
2. Why isn't "2 - 12" part of the answer for Cell 2?
0

LVL 18

Accepted Solution

Hi

here is my take on this.

Put all this in a standard module.

``````Dim dAllNums    As Object
Function SORTNUMS(ByRef Num, ByVal Delim As String) As String

Dim dNums   As Object
Dim dNum    As Object
Dim i       As Long
Dim x, y

Set dAllNums = CreateObject("scripting.dictionary")
Set dNums = CreateObject("scripting.dictionary")
Set dNum = CreateObject("scripting.dictionary")

If TypeOf Num Is Range Then Num = Num.Value2

x = Split(Num, Delim)

For i = 0 To UBound(x)
dNums.Item(Split(Trim(x(i)), "-")(0)) = Trim(x(i))
Next

x = SortA(dNums.keys)

For i = LBound(x) To UBound(x)
y = dNums.Item(x(i))
If Not dAllNums.exists(Val(x(i))) Then
dNum.Item(y) = Empty
End If
If InStr(1, y, "-") Then
FillNum Split(y, "-")(0), Val(Split(y, "-")(1))
Else
dAllNums.Item(Val(x(i))) = Empty
End If
Next

SORTNUMS = Join\$(dNum.keys, Delim)

End Function
Private Function SortA(ByRef v)

Dim i   As Long, j As Long, t

For i = LBound(v) To UBound(v)
For j = i To UBound(v)
If Val(v(j)) < Val(v(i)) Then
t = v(i)
v(i) = v(j)
v(j) = t
End If
Next
Next
SortA = v

End Function
Private Sub FillNum(ByVal StartNum As Long, Optional EndNum As Long)

Dim i   As Long

For i = StartNum To EndNum
dAllNums.Item(i) = Empty
Next

End Sub
``````

and use like

=SORTNUMS(A1,",")

Kris
0

LVL 29

Expert Comment

@MartinLiss,
I got confused with that too but I figured out that the first dash symbol was not part of the cell contents.  It would have been clearer this way:
Cell 1:  13, 14, 15, 13, 11-12, 14, 54, 14, 49, 12, 14, 23, 28-29, 29, 107, 13-14, 15, 18, 54, 14, 25-29, 10, 15, 20, 29
Cell 2:  12, 28, 44, 44, 59, 60, 61, 61, 42, 58

@LetsLearn
Here's a function that you can call to accomplish what you want.  You would call this function with something like  Cells(2, 1) = SortCell(Cells(1, 1))

``````Function SortCell(sCell As String) As String
Dim sHold As String, sPrev As String, sNext As String
Dim sArr As Variant
Dim i As Integer

sArr = Split(sCell & ",", ",")
i = 1

Do Until i = UBound(sArr)
sPrev = Trim(sArr(i - 1))
sNext = Trim(sArr(i))

If Val(sNext) < Val(sPrev) Then
'swap
sHold = sPrev
sArr(i - 1) = sNext
sArr(i) = sHold
If i > 1 Then i = i - 1
ElseIf sNext = sPrev And (sNext & sPrev) <> "" Then
'remove duplicates
sArr(i - 1) = ""
If i > 1 Then i = i - 1
Else
i = i + 1
End If
Loop

SortCell = Replace(Trim(Join(sArr, "  ")), "  ", ", ")

End Function
``````
And here are the results I got from your sample:
10, 11-12, 12, 13, 13-14, 14, 15, 18, 20, 23, 25-29, 28-29, 29, 49, 54, 107
12, 28, 42, 44, 58, 59, 60, 61
0

LVL 18

Expert Comment

BTW,

Replace FillNum sub with the following

``````Private Sub FillNum(ByVal StartNum As Long, Optional EndNum As Long)

Dim i   As Long

If EndNum < StartNum Then EndNum = StartNum

For i = StartNum To EndNum
dAllNums.Item(i) = Empty
Next

End Sub
``````
0

LVL 18

Expert Comment

@ IrogSinta

Results showing duplicates.

10, 11-12, 12, 13, 13-14, 14, 15, 18, 20, 23, 25-29, 28-29, 29, 49, 54, 107

Kris
0

Author Closing Comment

This will save me a huge amount of time. Thank you Kris
0

LVL 29

Expert Comment

Ah, I misunderstood the question.  I didn't think that a range and a single number where considered duplicates.  Good job, Kris.
0

LVL 29

Expert Comment

LetsLearn and Kris,
I just wanted to point out that accepted solution does have some quirks.
For instance, in your original sample, you had a range of 25-29;  If you add another range like 24-25, your original range 25-29 disappears.  Likewise, if you add 29-30, this new range doesn't even get included.

If you don't anticipate ranges that overlap then it's not a problem, but if you do, then just say so or open another question.

/Ron
0

Author Comment

Thanks Ron, yes that is true. If it is a problem I'll re-open the question.
0

LVL 18

Expert Comment

@ Ron,

Thanks for testing the code.

Here is revised one. This code will group the consecutive numbers, irrespective of the input structure.

``````Dim dAllNums    As Object
Function SORTNUMS(ByRef Num, ByVal Delim As String) As String

Dim i       As Long
Dim x, y, Flg As Boolean

Set dAllNums = CreateObject("scripting.dictionary")

If TypeOf Num Is Range Then Num = Num.Value2

x = Split(Num, Delim)

For i = 0 To UBound(x)
y = Split(x(i), "-")
If UBound(y) > 0 Then
FillNum Val(y(0)), Val(y(1))
Else
dAllNums.Item(Val(y(0))) = Empty
End If
Next

x = SortA(dAllNums.keys)
For i = LBound(x) + 1 To UBound(x)
If x(i) - x(i - 1) = 1 Then
If Not Flg Then y = x(i - 1): Flg = True
If i = UBound(x) Then SORTNUMS = SORTNUMS & Delim & y & "-" & x(i)
ElseIf x(i) - x(i - 1) > 1 Then
If Not Flg Then
SORTNUMS = SORTNUMS & Delim & x(i - 1)
Flg = False: y = x(i)
Else
If x(i - 1) - y > 1 Then
SORTNUMS = SORTNUMS & Delim & y & "-" & x(i - 1)
Flg = False: y = x(i)
Else
SORTNUMS = SORTNUMS & Delim & y
Flg = False: y = x(i)
End If
End If
If i = UBound(x) Then SORTNUMS = SORTNUMS & Delim & y
End If
Next
If Len(SORTNUMS) > Len(Delim) Then
SORTNUMS = Mid\$(SORTNUMS, Len(Delim) + 1)
End If

End Function
Private Function SortA(ByRef v)

Dim i   As Long, j As Long, t

For i = LBound(v) To UBound(v)
For j = i To UBound(v)
If Val(v(j)) < Val(v(i)) Then
t = v(i)
v(i) = v(j)
v(j) = t
End If
Next
Next
SortA = v

End Function
Private Sub FillNum(ByVal StartNum As Long, Optional EndNum As Long)

Dim i   As Long

If EndNum < StartNum Then EndNum = StartNum

For i = StartNum To EndNum
dAllNums.Item(i) = Empty
Next

End Sub
``````

Kris
0

Author Comment

Thank you Kris, deeply appreciate it.
0

## Featured Post

### Suggested Solutions

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.