Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
Solved

# Number ranges displayed in Excel

Posted on 2014-01-22
Medium Priority
332 Views
I have a list of numbers (sometimes in excess of 2,000) that I need to find each and every group of number ranges within this list.  As and example I have:
2889297
2889927
2889928
2889941
2889944
2889299
2889925
2889926
2889931
2889932
2889935
2889936
2889937
2889938
2889939
2889940
2889303
2889950

And first I would probably need the macro or whatever I use to sort by that number:
2889297
2889299
2889303
2889925
2889926
2889927
2889928
2889931
2889932
2889935
2889936
2889937
2889938
2889939
2889940
2889941
2889944
2889950

Then I would need it to display the beginning and ending numbers in each unbroken range like:
Index      Beginning Order      Ending Order
1                    2889297                  2889297
2                    2889299                  2889299
3                    2889303                  2889303
4                    2889925                  2889928
5                    2889931                  2889932
6                    2889935                  2889941
7                    2889944                  2889944
8                    2889950                  2889950

But the macro I have shows index 7 and 8 as a range, though it is not.  It shows index 7 as
Index      Beginning Order      Ending Order
7                    2889944                  2889950
and you can notice the numbers 2889945, 2889946, 2889947, 2889948 are not in the initial list of numbers, thus it would be a broken range, not unbroken.

The Macro I have is:
Sub FindRanges()
Application.ScreenUpdating = False

Dim jump As Integer
Dim range_index As Integer
Dim base_cell As Long
Dim next_1 As Long
Dim next_2 As Long

' Initialize ActiveCells positions, Sorts, and variables
range_index = 1

Sheets("Range List").Select
Cells.Range("A2").Select

Sheets("Order List").Select
Columns("A:A").Select
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Range("A2").Select

base_cell = ActiveCell.Value
next_1 = ActiveCell.Offset(1, 0).Value
next_2 = ActiveCell.Offset(2, 0).Value

Do
jump = 1

Do
If jump = 1 Then
If next_1 - base_cell <> 1 Then
next_2 = -1
next_1 = -1
End If
End If

If next_2 - next_1 = 1 Then
next_1 = ActiveCell.Offset(jump, 0).Value
next_2 = ActiveCell.Offset(jump + 1, 0).Value
jump = jump + 1
End If
Loop While next_2 - next_1 = 1

' Go to Range List and Input New Range
Sheets("Range List").Select
ActiveCell.Value = range_index
range_index = range_index + 1

ActiveCell.Offset(0, 1).Value = base_cell
If next_1 < 1 Then
ActiveCell.Offset(0, 2).Value = base_cell
Else
ActiveCell.Offset(0, 2).Value = next_1
If next_1 - base_cell = 1 Then
jump = jump + 1
End If
End If

ActiveCell.Offset(1, 0).Select

' Continue cycling through Orders
Sheets("Order List").Select
ActiveCell.Offset(jump, 0).Select
base_cell = ActiveCell.Value
next_1 = ActiveCell.Offset(1, 0).Value
next_2 = ActiveCell.Offset(2, 0).Value
Loop Until next_2 = 0

If next_2 = 0 Then
Sheets("Range List").Select
ActiveCell.Value = range_index
ActiveCell.Offset(0, 1).Value = base_cell
If next_1 = 0 Then
ActiveCell.Offset(0, 2).Value = base_cell
Else
ActiveCell.Offset(0, 2).Value = next_1
End If
End If

Sheets("Range List").Select
Application.ScreenUpdating = True
MsgBox ("Finished scanning range.")
End Sub

Can anyone provide me with a solution to my issue so I can feel comfortable that the ranges are accurate?  FYI, to be used in Excel 2010 or even 2003.

Thanks
0
Question by:tourmalinecanyon
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 5
• 2

LVL 24

Expert Comment

ID: 39800877
Could you post a very simple example workbook with an example of your data and how you want it outputting.
We can then create an improved code to perform the task for you.
ATB
Steve.
0

LVL 1

Author Comment

ID: 39801048
Hi Steve,

The example at the top is exactly what I want.  Enter data on one worksheet and results on the second after running the macro.

Data input:

2889297
2889927
2889928
2889941
2889944
2889299
2889925
2889926
2889931
2889932
2889935
2889936
2889937
2889938
2889939
2889940
2889303
2889950

Data output/results (desired):

Index      Beginning Order      Ending Order
1                    2889297                  2889297
2                    2889299                  2889299
3                    2889303                  2889303
4                    2889925                  2889928
5                    2889931                  2889932
6                    2889935                  2889941
7                    2889944                  2889944
8                    2889950                  2889950

Thanks
Ranges.xls
0

LVL 24

Accepted Solution

Steve earned 2000 total points
ID: 39801200
OK, the attached workbook has the following code:
``````Sub DoMacro()

Dim ws As Worksheet
Set ws = Sheets("Sheet1")
Dim r
Dim d As Object
Set d = CreateObject("scripting.dictionary")

r = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value

For x = 1 To UBound(r)
If Not d.exists(r(x, 1)) Then
End If

Next x

iMin = WorksheetFunction.Min(r)
iMax = WorksheetFunction.Max(r)

Dim outputArr()
ReDim outputArr(1 To 3, 1 To 1)
ct = 1

For x = iMin To iMax
If d.exists(x) Then
If outputArr(2, ct) = Empty Then
outputArr(1, ct) = ct
outputArr(2, ct) = x
outputArr(3, ct) = x
ElseIf d.exists(x - 1) Then
outputArr(3, ct) = x
End If

End If
If d.exists(x + 1) And Not d.exists(x) Then
ct = ct + 1
ReDim Preserve outputArr(1 To 3, 1 To ct)
End If
Next x
ws.Range("C1").Resize(ct, 3) = Application.Transpose(outputArr)

End Sub
``````

If you paste your values into column A starting at A1 and run the macro you should get your desired result.

Have a test and I will look at implementing it into your workbook (not looked at that yet).
ATB
Steve.
Example.xlsm
0

LVL 24

Expert Comment

ID: 39801210
Ranges.xls
0

LVL 1

Author Closing Comment

ID: 39801368
The revision you did to my original workbook still has the same problem, but your example.xlsm with the results staying on the same page works exactly as I need for the results.  I'd love to integrate the differences into my original and probably update it to an xlsm and not a excel 2003 format, but I can live with it this way too.

At least my users can get their job done a bit more efficiently!

Thanks

Cheers,
David
0

LVL 24

Expert Comment

ID: 39801376
I will re-write to the same format as your file but in xlsm format.
Will post it here tomorrow for you.
any issues post here and I will fix :)

ATB
Steve.
0

LVL 24

Expert Comment

ID: 39803336
The attached has a "better" macro in it:
``````Option Explicit
Sub DoMacroSort()

Dim wsFrom As Worksheet: Set wsFrom = Sheets("Order List")
Dim wsTo As Worksheet: Set wsTo = Sheets("Range List")
Dim r: r = wsFrom.Range("A2:A" & wsFrom.Range("A" & Rows.Count).End(xlUp).Row).Value
Dim d As Object: Set d = CreateObject("scripting.dictionary")
Dim x As Long, ct As Long: ct = 1
Dim outputArr(): ReDim outputArr(1 To 3, 1 To 1)
Dim iMin As Long, iMax As Long

For x = 1 To UBound(r)
If Not d.exists(r(x, 1)) Then
End If
Next x

iMin = WorksheetFunction.Min(r)
iMax = WorksheetFunction.Max(r)

Dim TheValues
TheValues = d.keys

Call QuickSort(TheValues, LBound(TheValues), UBound(TheValues))

For x = LBound(TheValues) To UBound(TheValues)

If outputArr(2, ct) = Empty Then
outputArr(1, ct) = ct
outputArr(2, ct) = TheValues(x)
outputArr(3, ct) = TheValues(x)
Else
outputArr(3, ct) = TheValues(x)
End If

If Not x = UBound(TheValues) Then
If Not TheValues(x) + 1 = TheValues(x + 1) Then
ct = ct + 1
ReDim Preserve outputArr(1 To 3, 1 To ct)
End If
End If
Next x

wsTo.Range("A2").Resize(ct, 3) = Application.Transpose(outputArr)

End Sub

Sub QuickSort(arr, Lo As Long, Hi As Long)
Dim varPivot As Variant
Dim varTmp As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = Lo
tmpHi = Hi
varPivot = arr((Lo + Hi) \ 2)
Do While tmpLow <= tmpHi
Do While arr(tmpLow) < varPivot And tmpLow < Hi
tmpLow = tmpLow + 1
Loop
Do While varPivot < arr(tmpHi) And tmpHi > Lo
tmpHi = tmpHi - 1
Loop
If tmpLow <= tmpHi Then
varTmp = arr(tmpLow)
arr(tmpLow) = arr(tmpHi)
arr(tmpHi) = varTmp
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Loop
If Lo < tmpHi Then QuickSort arr, Lo, tmpHi
If tmpLow < Hi Then QuickSort arr, tmpLow, Hi
End Sub
``````

This should work better over larger data sets.
Ranges.xlsm
0

## Featured Post

Question has a verified solution.

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

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Although Jacob Bernoulli (1654-1705) has been credited as the creator of "Binomial Distribution Table", Gottfried Leibniz (1646-1716) did his dissertation on the subject in 1666; Leibniz you may recall is the co-inventor of "Calculus" and beat Isaacâ€¦
###### Suggested Courses
Course of the Month9 days, 16 hours left to enroll