?
Solved

Sorting numbers within an Excel cell

Posted on 2012-09-21
14
Medium Priority
?
389 Views
Last Modified: 2012-09-22
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
Comment
Question by:LetsLearn
  • 4
  • 4
  • 3
  • +2
14 Comments
 
LVL 12

Expert Comment

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

Author Comment

by:LetsLearn
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

by:tel2
ID: 38424071
And now we wait...
(for some Excel guru who know's what (s)he's doing)
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 50

Expert Comment

by:Martin Liss
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

by:
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

Open in new window


and use like

=SORTNUMS(A1,",")

Kris
0
 
LVL 29

Expert Comment

by:IrogSinta
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

Open in new window

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

by:krishnakrkc
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

Open in new window

0
 
LVL 18

Expert Comment

by:krishnakrkc
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

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

Expert Comment

by:IrogSinta
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

by:IrogSinta
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

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

Expert Comment

by:krishnakrkc
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

Open in new window


Kris
0
 

Author Comment

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

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

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.

840 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question