Solved

# Sorting numbers within an Excel cell

Posted on 2012-09-21
Medium Priority
389 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
• 4
• 4
• 3
• +2

LVL 12

Expert Comment

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

Author Comment

ID: 38424064
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 12

Expert Comment

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

LVL 50

Expert Comment

ID: 38424108
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

krishnakrkc earned 2000 total points
ID: 38424189
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

ID: 38424192
@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

ID: 38424199
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

ID: 38424203
@ 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

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

LVL 29

Expert Comment

ID: 38424270
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

ID: 38425444
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

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

LVL 18

Expert Comment

ID: 38425763
@ 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

ID: 38425766
Thank you Kris, deeply appreciate it.
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
###### Suggested Courses
Course of the Month15 days, 6 hours left to enroll