Converting sequential numbers in one column to ranges in two columns

Hpotter73

New Member
Joined
Sep 21, 2019
Messages
5
Hi,
I have sequential numbers below in column A of excel.
M66.211
M66.212
M66.213
M66.214
M66.215
M66.216
M66.217
M66.218
M66.219
M66.811
M66.812
M66.813
M66.814
M66.815
M66.816
M66.817
M66.823
M66.824
M66.825
M66.826
M66.827
M66.828
M66.829
M66.830
<colgroup><col width="72" style="width: 54pt;"> <tbody> </tbody>

I want to covert this into
M66.211M66.219
M66.811M66.817
M66.823M66.830
<colgroup><col width="72" style="width: 54pt;" span="2"> <tbody> </tbody>

Is there a macro that can help with this

Thank you
<colgroup><col width="72" style="width: 54pt;" span="2"> <tbody> </tbody>
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Welcome to the MrExcel board!

Assuming that data starts at row 2 of column A and results can go in columns B:C, try this with a copy of your workbook.

Code:
Sub Get_Sequences()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long
  
  With Range("A2", Range("A" & Rows.Count).End(xlUp).Offset(1))
    a = .Value
    a(UBound(a), 1) = "0.0"
    ReDim b(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a) - 1
      If j = 0 Then
        k = k + 1
        b(k, 1) = a(i, 1)
        j = 1
      End If
      If Split(a(i, 1), ".")(1) + 1 <> Split(a(i + j, 1), ".")(1) + 0 Then
        b(k, 2) = a(i, 1)
        j = 0
      End If
    Next i
    .Offset(, 1).Resize(k, 2).Value = b
  End With
End Sub
 
Upvote 0
Using the same assumptions that Peter made, here is another macro to consider...
Code:
Sub Get_Sequences()
  Application.ScreenUpdating = False
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Copy .Offset(, 1).Resize(, 2)
    .Offset(, 1).Value = Evaluate(Replace("IF(0+RIGHT(@,3)=IFERROR(1+RIGHT(" & .Offset(-1, 1).Address & ",3),1),"""",@)", "@", .Offset(, 1).Address))
    .Offset(, 2).Value = Evaluate(Replace("IF(0+RIGHT(@,3)=IFERROR(RIGHT(" & .Offset(1, 2).Address & ",3)-1,1),"""",@)", "@", .Offset(, 2).Address))
    .Offset(, 1).Resize(, 2).SpecialCells(xlBlanks).Delete xlShiftUp
  End With
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Thank you very much. I tried this I am getting Type mismatch error.
Are you responding to Peter or me?

Either of us would need to know on which line of code the error occurred on?
 
Last edited:
Upvote 0
I was responding to Peter. The error I am getting is Type mismatch error 13. It does seem may data also has alphabets in the end A- Z not just numbers. May be that is the reason for the error
 
Upvote 0
It does seem may data also has alphabets in the end A- Z not just numbers. May be that is the reason for the error
Yes, if you do not have digits only after the decimal point, then that would affect the calculations Peter and my codes were doing. Please show us before and after data (like you did in Message #1 ) but include representative samples of the different types of values that need to be processed.

Please Note
-------------------
One thing you must keep in mind when you ask a question in a forum... the people you are asking to help you know absolutely nothing about your data, absolutely nothing about how it is laid out in the workbook, absolutely nothing about what you want done with it and absolutely nothing about how whatever it is you want done is to be presented back to you as a result... you must be very specific about describing each of these areas, in detail, and you should not assume that we will be able to "figure it out" on our own. Remember, you are asking us for help... so help us to be able to help you by providing the information we need to do so, even if that information seems "obvious" to you (remember, it is only obvious to you because of your familiarity with your data).
 
Upvote 0
T85.625S
T85.625A
T85.625D
T85.635D
T85.635A
T85.113D
T85.113A
T85.113S
T85.123A
T85.123D
T85.123S
T85.193A
T85.193D
T85.615A
T85.193S
T85.615D
T85.615S
T85.695A
T85.635S
T85.695D
T85.695S
T85.730D
T85.730A
T85.731A
T85.730S
T85.731D
T85.731S
T85.732A
T85.732D
T85.732S
T85.733A
T85.733D
T85.733S
<colgroup><col width="64" style="width: 48pt;"> <tbody> </tbody>

This is the other type of data that I have
Similar to numbers I am looking to put these ranges
T85.625A - T85.625 S
T85.732A- T573D
 
Upvote 0
:confused: Well, I am a little confused now. In your original message, the values after the dot were actually sequential (211, 212, 213, etc.) and you want them condensed to remove the middle of the sequence and just show the sequences end points with a dash between them. That was quite logical and in keeping with standard practices. However, the example you show above is not sequential at all... you say for T85.625S, T85.625A, T85.625D that you want to show it as T85.625A-T85.625AS... there is nothing sequential about that. How would anyone know the hidden value is T85.625D and not T85.625E or even T85.625B,T85.625D,T85.625K or any other combination? I would remind you that your thread title uses the word "sequential". And what about your original post... do you have those number mixed-in with the ones you just showed us?
 
Last edited:
Upvote 0
:confused: Well, I am a little confused now.
More than a little for me! :unsure:


BTW, were you still a little verbose with your previous code? :p
That is, wouldn't this have done?
Using the same assumptions that Peter made, here is another macro to consider...
Code:
Sub Get_Sequences()
  Application.ScreenUpdating = False
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    <del>[COLOR="#FF0000"].Copy .Offset(, 1).Resize(, 2)[/COLOR]</del>
    .Offset(, 1).Value = Evaluate(Replace("IF(0+RIGHT(@,3)=IFERROR(1+RIGHT(" & .Offset(-1<del>[COLOR="#FF0000"], 1[/COLOR]</del>).Address & ",3),1),"""",@)", "@", <del>[COLOR="#FF0000"].Offset(, 1)[/COLOR]</del>.Address))
    .Offset(, 2).Value = Evaluate(Replace("IF(0+RIGHT(@,3)=IFERROR(RIGHT(" & .Offset(1<del>[COLOR="#FF0000"], 2[/COLOR]</del>).Address & ",3)-1,1),"""",@)", "@", <del>[COLOR="#FF0000"].Offset(, 2)[/COLOR]</del>.Address))
    .Offset(, 1).Resize(, 2).SpecialCells(xlBlanks).Delete xlShiftUp
  End With
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,212,933
Messages
6,110,752
Members
448,295
Latest member
Uzair Tahir Khan

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