Converting sequential numbers in one column to ranges in two columns

Hpotter73

New Member
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>
 

Peter_SSs

MrExcel MVP, Moderator
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
 

Rick Rothstein

MrExcel MVP
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
 

Rick Rothstein

MrExcel MVP
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:

Hpotter73

New Member
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
 

Rick Rothstein

MrExcel MVP
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).
 

Hpotter73

New Member
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
 

Rick Rothstein

MrExcel MVP
: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:

Peter_SSs

MrExcel MVP, Moderator
: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:

Some videos you may like

This Week's Hot Topics

  • Get External Data (long shot question!)
    This is likely a long shot but I am wondering if it is at all possible for Excel to somehow 'change' the contents of a URL that is being linked to...
  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • Cell Formatting
    Good Morning, I need to format a few different cells in the following manners: A1 has to always add a colon (:) after whatever is typed in by a...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • Workbook_Change stopped working !
    I am working on an app to speed up & automate processing of Credit Cards statements. After data is input from a CSV file, it is presented to the...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
Top