Converting Consecutive Numbers into a Range

Tyndie

New Member
Joined
Jun 16, 2008
Messages
10
Hi,

Can you give me some pointers please with a problem I am having trouble to solve.

I have a list of numbers with a references which are sorted lowest to highest for each reference:

For Example

<TABLE style="WIDTH: 96pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=128 border=0><COLGROUP><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; WIDTH: 48pt; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" width=64 height=20>B1</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; WIDTH: 48pt; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right width=64>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B1</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B2</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B2</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B2</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>4</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B3</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>12</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B3</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>13</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; HEIGHT: 15pt; BACKGROUND-COLOR: transparent" height=20>B3</TD><TD style="BORDER-RIGHT: #e2e2e2; BORDER-TOP: #e2e2e2; BORDER-LEFT: #e2e2e2; BORDER-BOTTOM: #e2e2e2; BACKGROUND-COLOR: transparent" align=right>15</TD></TR></TBODY></TABLE>

What I want to do for each B reference is where each of the number cells is a consecutive number, convert this to a range with highest to lowest with a comma prefixed before the range

Where the number isnt consecutive, i just want to prefix the comma with the number.

For example B3 would be 12-13,15

Can anyone help please?
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
It's easy(The 2nd column need not to sort):

Code:
Sub Test()
Dim arr, i As Long, r As Range, temp As String, result As String
On Error Resume Next
arr = [a1].CurrentRegion
For i = 1 To UBound(arr) + 1
If arr(i, 1) <> temp Then
result = result & vbCrLf & temp & ":" & Replace(Replace(r.Address(0, 0), ":", "-"), "X", "")
temp = arr(i, 1)
Set r = Range("X" & arr(i, 2))
Else
Set r = Union(r, Range("X" & arr(i, 2)))
End If
Next
MsgBox result
End Sub

Regards
Northwolves
 
Upvote 0
That works great thanks, I am trying to get it so on "Sheet 2" it will put the A column reference from Sheet 1 in Column A, and the ranges in column B but I keep on getting some weird character with a question mark in a circle.

Any ideas on what is causing this please?
 
Upvote 0
This UDF is another approach. If your data is in colums A and B
=mergeConsecutiveMatches("B3",A:B) will return the string "12-13,15"

Note that
=mergeConsecutiveMatches("B2",A:B) returns "3,1,4" since neither 3,1 nor 1,4 are consecutive numbers.

Code:
Function MergeConsecutiveMatches(matchVal As String, ByVal dataRange As Range) As String
Dim oneCell As Range, arrayForString As Variant, pointer As Long
On Error GoTo HaltFunction
    With dataRange
        Set dataRange = Application.Intersect(dataRange, .Parent.UsedRange)
    End With
    With dataRange
        With .Resize(.Rows.Count, 1)
            ReDim arrayForString(1 To .Cells.Count)
            For Each oneCell In Range(.Cells(Application.Match(matchVal, .Cells, 0), 1), .Cells(.Rows.Count, 1))
                With oneCell
                    If .Value = matchVal Then
                        pointer = pointer + 1
                        arrayForString(pointer) = Val(CStr(.Offset(0, 1).Value))
                    End If
                End With
            Next oneCell
            ReDim Preserve arrayForString(1 To pointer)
            MergeConsecutiveMatches = JoinConsecutive(arrayForString)
        End With
    End With

HaltFunction:
    On Error GoTo 0
End Function

Private Function JoinConsecutive(inRRay As Variant) As String
    Dim oneNum As Variant, lastNum As Double
    Dim consecutiveFlag As Boolean

    For Each oneNum In inRRay
        If oneNum = 2 And lastNum = 1 Then JoinConsecutive = ",1"
        If oneNum = lastNum + 1 Then
            If Not (consecutiveFlag) Then JoinConsecutive = JoinConsecutive & "-"
            consecutiveFlag = True
        Else
            If consecutiveFlag Then JoinConsecutive = JoinConsecutive & lastNum
            consecutiveFlag = False
            JoinConsecutive = JoinConsecutive & "," & oneNum
        End If
        lastNum = oneNum
    Next oneNum
    
    If consecutiveFlag Then JoinConsecutive = JoinConsecutive & lastNum
    JoinConsecutive = Mid(JoinConsecutive, 2)
    
End Function
 
Upvote 0
There seems to be a problem with the second one, where the initial number is say 0 with consecutive numbers to 9, it outputs it as 19 instead of 0-9, any ideas on how to fix this please?
 
Upvote 0
Just needed to add one character
Code:
Private Function JoinConsecutive(inRRay As Variant) As String
    Dim oneNum As Variant, lastNum As Double
    Dim consecutiveFlag As Boolean

    For Each oneNum In inRRay
        If oneNum = 2 And lastNum = 1 Then JoinConsecutive = [COLOR="Red"]",1-":Rem correction[/COLOR] 
        If oneNum = lastNum + 1 Then
            If Not (consecutiveFlag) Then JoinConsecutive = JoinConsecutive & "-"
            consecutiveFlag = True
        Else
            If consecutiveFlag Then JoinConsecutive = JoinConsecutive & lastNum
            consecutiveFlag = False
            JoinConsecutive = JoinConsecutive & "," & oneNum
        End If
        lastNum = oneNum
    Next oneNum
    
    If consecutiveFlag Then JoinConsecutive = JoinConsecutive & lastNum
    JoinConsecutive = Mid(JoinConsecutive, 2)
    
End Function
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,114,002
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top