How to group consecutive and non consecutive phone numbers

[traveler84]

Off and on for many years, I've battled an issue and I'm hoping someone might have more ridges in their brain than me.

I have a large list of phone numbers in order. What I need to do is group consecutive ranges into a format of ##########-####. Everything is standard in column A with normal formatting with no fancy codes. Literally just the phone numbers.

Example:
5550000000
5550001111
5550001112
5550001114
5550001115

Output:
5550000000
5550001111-1112
5550001114-1115


I have thousands of phone numbers that I have to find those breaks. I often cheat a little by using a =IF(A2-A1=1),"RANGE","NOT RANGE." Or I might use MID to do the same with the last 4 values depending on my flavor of the day.

My experiments:

I've figured out how to identify if a number is consecutive and flag it as such.

I have used conditional formatting, copied into WORD and back into excel, then used a VBA formula to find where each break is in the list of TNs by identifying the color code.

Issue:

I can't seem to figure out how if I say I have 5 or 50 in a range, how to output them out as such and also identify the non ranges in a list. Is there a VBA script that could help with this?

 

[kennypete]

Side question, I didn't want to ask initially because I was worried about asking for too much. Is there a way to instead of having a TN like:

5551110000-5551110010

to have an output like

5551110000-0010

I’m not sure whether you tried my solution but, as the animated gif shows, it already does that. Also, a dictionary/collection approach with this sort of thing may be good for further extension. For example, say you wanted to know whether there’s a number that “leads” a group. Another may be wanting to know what the largest groups of consecutive numbers are, etc.
@Peter_SSs’ solution is great insofar as using the range-to-array approach (wish I’d done that as the initial step) in terms of speed, though sometimes having a dictionary available to interrogate may prove useful. And speed should not be much of a factor here because with 50k numbers it’s a matter of a few seconds’ difference.

 

[Peter_SSs]

Side question, I didn't want to ask initially because I was worried about asking for too much. Is there a way to instead of having a TN like:

5551110000-5551110010

to have an output like

5551110000-0010

Basically the last 4 of the TN that range.

What about if you had this set of numbers. Using the last 4 digits for the result column as I have shown would make for a strange result wouldn't it?

traveler84 2020-02-19 1.xlsm
	A	B
16	5550019997	5550019997-0002
17	5550019998
18	5550019999
19	5550020000
20	5550020001
21	5550020002
Phone Numbers

Never-the-less, the only change required to my code is shown below.

Sub Group_Numbers_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long
 
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 2 To UBound(a)
    If a(i, 1) <> Val(a(i - 1, 1)) + 1 Then
      k = k + 1
      b(k, 1) = a(i, 1)
    Else
      b(k, 1) = Split(b(k, 1), "-")(0) & "-" & Right(a(i, 1), 4)
    End If
  Next i
  Range("B2").Resize(k).Value = b
End Sub

 

[traveler84]

Oh wow @Peter_SSs ! Yeah, you were right about it not looking functional but I was going to write it off as a junk sheet to do the calculations on but now this just changed the whole thing and saved me a lot of additional steps to fix.

See, I had figured out the Loop though! (I promise I wasn't one to come on and beg for help without a good try.) I had to make "i" a variable based on the row of the last item and after some working it out, I got it to work.

But I like your way better cause it just saved me a bunch of extra steps that followed after this code too. And after testing it out, it worked just as expected with live numbers.

Sub Fixtnformat()
Dim First As String
Dim Lastfour As String

Dim i As Integer
Dim lRow As Long
Dim lCol As Long

'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 1 To lRow
    First = Mid(Range("B0" & i), 1, 11)
    Lastfour = Mid(Range("B0" & i), 18, 4)
    ActiveSheet.Range("C" & i).Value = First & Lastfour
    Next i



End Sub

 

[traveler84]

I really want to thank everyone who responded. You honestly don't understand how long of a challenge this has been. I've tried to figure out the VBA part of this for years. I would say at least 5 or more. I know I have some questions in my inbox that I've asked other places back in 2015 and off and on it's been a side project until I gave up. So thank you very much again!!! I'm so happy!

 

[Peter_SSs]

You're welcome.

 

[footoo]

Re post #7, perhaps just amend Peter_Ss's code slightly :

Sub Group_Numbers()
  Dim a As Variant, b As Variant
  Dim i As Long, k As Long

  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 2 To UBound(a)
    If a(i, 1) <> Val(a(i - 1, 1)) + 1 Then
      k = k + 1
      b(k, 1) = a(i, 1)
    Else
      b(k, 1) = Split(b(k, 1), "-")(0) & -Right(a(i, 1), 4)
    End If
  Next i
  Range("B2").Resize(k).Value = b
End Sub

 

[Peter_SSs]

Perhaps just amend Peter_Ss's code slightly :

I deliberately changed from that way of doing it. Try with this group of numbers

traveler84 2020-02-19 1.xlsm
	A
2	5550000000
3	5550000011
4	5550000012
5	5550000013
6	5550001115
Phone Numbers (2)

 

[footoo]

I deliberately changed from that way of doing it. Try with this group of numbers

traveler84 2020-02-19 1.xlsm
	A
2	5550000000
3	5550000011
4	5550000012
5	5550000013
6	5550001115
Phone Numbers (2)

Maybe this :

Sub Group_Numbers()
Dim a As Variant, b As Variant
Dim i As Long, k As Long
a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 2 To UBound(a)
    If Left(a(i, 1), 6) <> Left(Val(a(i - 1, 1)), 6) _
       Or a(i, 1) <> Val(a(i - 1, 1)) + 1 Then
        k = k + 1
        b(k, 1) = a(i, 1)
    Else
        b(k, 1) = Split(b(k, 1), "-")(0) & "-" & Right(-a(i, 1), 4)
    End If
Next i
Range("B2").Resize(k).Value = b
End Sub

 

[Peter_SSs]

Maybe this :

It works, but it is pretty much identical to post #12 apart from an extra check ..
Left(a(i, 1), 6) <> Left(Val(a(i - 1, 1)), 6)
.. which as far as I can see does nothing since that condition would already be covered by the 'Or' anyway
a(i, 1) <> Val(a(i - 1, 1)) + 1

Am I missing something?


BTW, the final - in this line is also not required (though it will do no harm)
b(k, 1) = Split(b(k, 1), "-")(0) & "-" & Right(-a(i, 1), 4)

 

[footoo]

It works, but it is pretty much identical to post #12 apart from an extra check ..
Left(a(i, 1), 6) <> Left(Val(a(i - 1, 1)), 6)
.. which as far as I can see does nothing since that condition would already be covered by the 'Or' anyway
a(i, 1) <> Val(a(i - 1, 1)) + 1

Am I missing something?

The extra check is to handle the sample data in post #12 (the "Or" doesn't cover it) - i.e. 5550019999 / 5550020000
The previous code did not handle properly.