Extend a range of numbers (with text prefixes)

americanuser2016

New Member
Joined
Oct 10, 2016
Messages
3
Hi, I need help from an expert. I want to extend a range of numbers with text prefixes using a VBA. It's better if I use an example:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Input Column
[/TD]
[TD]Output Column
[/TD]
[/TR]
[TR]
[TD]R1,R2-5,R9,R10,R12-13
[/TD]
[TD]
[TABLE="width: 199"]
<tbody>[TR]
[TD]R1,R2,R3,R4,R5,R9,R10,R12,R13
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]
[TABLE="width: 145"]
<tbody>[TR]
[TD]CR1-3,CR99
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]
[TABLE="width: 199"]
<tbody>[TR]
[TD]CR1,CR2,CR3,CR99
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]
[TABLE="width: 145"]
<tbody>[TR]
[TD]D1-D3
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]
[TABLE="width: 199"]
<tbody>[TR]
[TD]D1,D2,D3
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
[TR]
[TD]
[TABLE="width: 145"]
<tbody>[TR]
[TD]L1, L3,L4
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD]
[TABLE="width: 199"]
<tbody>[TR]
[TD]L1,L3,L4
[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

The text prefix can be any text and ranges from 1-4 letters, but the prefix is static for that row. There is also an undefined number of variables in the input column, there can be as many as 1000+ numbers. I separated the input and out put columns for clarity, but I actually want the output data to overwrite into the same column as the input.
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
I imagine Rick's reference will provide a fast and dependable solution, but if you would rather just copy and paste some code from this post, I think this will do what you want. Be sure to select the cells (assumed to be in a single column) you want the macro to reconfigure before you run the macro.
Code:
Sub ExtendNumbers()
'Select the cells you want to modify, then run this macro
Dim c As Range, V As Variant, i As Long, j As Long
Dim S As String, Prefix As String, Num1 As Long, Num2 As Long
Application.ScreenUpdating = False
For Each c In Selection
    If IsEmpty(c) Or InStr(c.Value, "-") = 0 Then GoTo Nx
    If InStr(c.Value, ",") = 0 Then
        For i = 1 To InStr(c.Value, "-") - 1
            If Mid(c, i, 1) Like "[A-Z]" Then
                S = S & Mid(c, i, 1)
            ElseIf Mid(c, i, 1) Like "#" Then
                Prefix = S
                S = ""
                Exit For
            End If
        Next i
        Num1 = Val(Replace(Split(c.Value, "-")(0), Prefix, ""))
        Num2 = Val(Replace(Split(c.Value, "-")(1), Prefix, ""))
        For j = Num1 - 1 To Num2 - 1
            S = S & "," & Prefix & j + 1
        Next j
        c.Value = Right(S, Len(S) - 1)
    Else
        For i = 1 To InStr(c.Value, ",") - 1
            If Mid(c, i, 1) Like "[A-Z]" Then
                S = S & Mid(c, i, 1)
            ElseIf Mid(c.Value, i, 1) Like "#" Then
                Prefix = S
                S = ""
                Exit For
            End If
        Next i
        V = Split(c.Value, ",")
        For i = LBound(V) To UBound(V)
            If InStr(V(i), "-") = 0 Then
                S = S & "," & V(i)
            Else
                Num1 = Val(Replace(Split(V(i), "-")(0), Prefix, ""))
                Num2 = Val(Replace(Split(V(i), "-")(1), Prefix, ""))
                For j = Num1 - 1 To Num2 - 1
                    S = S & "," & Prefix & j + 1
                Next j
            End If
        Next i
        c.Value = Right(S, Len(S) - 1)
    End If
Nx:
S = ""
Next c
Columns(Selection.Column).AutoFit
Application.ScreenUpdating = True
End Sub
 
Upvote 0
...but if you would rather just copy and paste some code from this post...
Point taken, so here is the relevant part from my mini-blog article (note that the UDF provides more functionality than the OP asked for)...

A small sampling of the kinds of input which the UDF below will be able to process would be...

1,5,9-12,20-18
1 5 9-12 20-15
1,5 9-12, 20 - 15
AB8-AB12
CD3 - CD7 K4, P2-P5 JM8 - JM3
ABCD1-9
XYZ3 - 7

The things to note about the above series is you can mix the space and/or comma delimiter between series items at will, series items be just one item (no dash), the numeric parts of a dashed series can advance either up (A1-A5) or down (B5-B1) and the series will be produced in that order, and the second part of a dashed series can have the text prefix omitted (the text prefix from the first part of that dashed series will be automatically assumed to apply to the second part). One thing which does not show up in the above list, but is permitted, is multiple spaces... you are not restricted to single spaces, use as many as you want as the extra ones will be thrown away during processing. Okay, here is the code that perform the "magic"...
Code:
[table="width: 500"]
[tr]
	[td]Function ExpandedSeries(ByVal S As String, Optional Delimiter As String = ", ") As Variant
  Dim X As Long, Y As Long, Z As Long
  Dim Letter As String, Numbers() As String, Parts() As String
  S = Chr$(1) & Replace(Replace(Replace(Replace(Application.Trim(Replace(S, ",", _
      " ")), " -", "-"), "- ", "-"), " ", " " & Chr$(1)), "-", "-" & Chr$(1))
  Parts = Split(S)
  For X = 0 To UBound(Parts)
    If Parts(X) Like "*-*" Then
      For Z = 1 To InStr(Parts(X), "-") - 1
        If IsNumeric(Mid(Parts(X), Z, 1)) And Mid$(Parts(X), Z, 1) <> "0" Then
          Letter = Left(Parts(X), Z + (Left(Parts(X), 1) Like "[A-Za-z" & Chr$(1) & "]"))
          Exit For
        End If
      Next
      Numbers = Split(Replace(Parts(X), Letter, ""), "-")
      If Not Numbers(1) Like "*[!0-9" & Chr$(1) & "]*" Then Numbers(1) = Val(Replace(Numbers(1), Chr$(1), "0"))
      On Error GoTo SomethingIsNotRight
      For Z = Numbers(0) To Numbers(1) Step Sgn(-(Numbers(1) > Numbers(0)) - 0.5)
        ExpandedSeries = ExpandedSeries & Delimiter & Letter & Z
      Next
    Else
      ExpandedSeries = ExpandedSeries & Delimiter & Parts(X)
    End If
  Next
  ExpandedSeries = Replace(Mid(ExpandedSeries, Len(Delimiter) + 1), Chr$(1), "")
  Exit Function
SomethingIsNotRight:
  ExpandedSeries = CVErr(xlErrValue)
End Function[/td]
[/tr]
[/table]

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use ExpandedSeries just like it was a built-in Excel function. For example,

=ExpandedSeries (A1)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.
 
Last edited:
Upvote 0
Point taken, so here is the relevant part from my mini-blog article (note that the UDF provides more functionality than the OP asked for)...

A small sampling of the kinds of input which the UDF below will be able to process would be...

1,5,9-12,20-18
1 5 9-12 20-15
1,5 9-12, 20 - 15
AB8-AB12
CD3 - CD7 K4, P2-P5 JM8 - JM3
ABCD1-9
XYZ3 - 7

The things to note about the above series is you can mix the space and/or comma delimiter between series items at will, series items be just one item (no dash), the numeric parts of a dashed series can advance either up (A1-A5) or down (B5-B1) and the series will be produced in that order, and the second part of a dashed series can have the text prefix omitted (the text prefix from the first part of that dashed series will be automatically assumed to apply to the second part). One thing which does not show up in the above list, but is permitted, is multiple spaces... you are not restricted to single spaces, use as many as you want as the extra ones will be thrown away during processing. Okay, here is the code that perform the "magic"...
Wow - that's nifty, especially the ability to cover a broad range of input. I have added this UDF to my Personal.xlsb workbook. :)
 
Upvote 0
Wow - that's nifty, especially the ability to cover a broad range of input. I have added this UDF to my Personal.xlsb workbook. :)
Hey, thanks, I am glad you liked it. And I am honored that you felt it worthy to include in your Personal.xlsb workbook.:bow:
 
Upvote 0
Point taken, so here is the relevant part from my mini-blog article (note that the UDF provides more functionality than the OP asked for)...

A small sampling of the kinds of input which the UDF below will be able to process would be...

1,5,9-12,20-18
1 5 9-12 20-15
1,5 9-12, 20 - 15
AB8-AB12
CD3 - CD7 K4, P2-P5 JM8 - JM3
ABCD1-9
XYZ3 - 7

The things to note about the above series is you can mix the space and/or comma delimiter between series items at will, series items be just one item (no dash), the numeric parts of a dashed series can advance either up (A1-A5) or down (B5-B1) and the series will be produced in that order, and the second part of a dashed series can have the text prefix omitted (the text prefix from the first part of that dashed series will be automatically assumed to apply to the second part). One thing which does not show up in the above list, but is permitted, is multiple spaces... you are not restricted to single spaces, use as many as you want as the extra ones will be thrown away during processing. Okay, here is the code that perform the "magic"...
Code:
[TABLE="width: 500"]
<tbody>[TR]
[TD]Function ExpandedSeries(ByVal S As String, Optional Delimiter As String = ", ") As Variant
  Dim X As Long, Y As Long, Z As Long
  Dim Letter As String, Numbers() As String, Parts() As String
  S = Chr$(1) & Replace(Replace(Replace(Replace(Application.Trim(Replace(S, ",", _
      " ")), " -", "-"), "- ", "-"), " ", " " & Chr$(1)), "-", "-" & Chr$(1))
  Parts = Split(S)
  For X = 0 To UBound(Parts)
    If Parts(X) Like "*-*" Then
      For Z = 1 To InStr(Parts(X), "-") - 1
        If IsNumeric(Mid(Parts(X), Z, 1)) And Mid$(Parts(X), Z, 1) <> "0" Then
          Letter = Left(Parts(X), Z + (Left(Parts(X), 1) Like "[A-Za-z" & Chr$(1) & "]"))
          Exit For
        End If
      Next
      Numbers = Split(Replace(Parts(X), Letter, ""), "-")
      If Not Numbers(1) Like "*[!0-9" & Chr$(1) & "]*" Then Numbers(1) = Val(Replace(Numbers(1), Chr$(1), "0"))
      On Error GoTo SomethingIsNotRight
      For Z = Numbers(0) To Numbers(1) Step Sgn(-(Numbers(1) > Numbers(0)) - 0.5)
        ExpandedSeries = ExpandedSeries & Delimiter & Letter & Z
      Next
    Else
      ExpandedSeries = ExpandedSeries & Delimiter & Parts(X)
    End If
  Next
  ExpandedSeries = Replace(Mid(ExpandedSeries, Len(Delimiter) + 1), Chr$(1), "")
  Exit Function
SomethingIsNotRight:
  ExpandedSeries = CVErr(xlErrValue)
End Function[/TD]
[/TR]
</tbody>[/TABLE]

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use ExpandedSeries just like it was a built-in Excel function. For example,

=ExpandedSeries (A1)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Hey Rick, This is a great UDF! I've used it with great success on several lists however I did find some issues also. As americanuser2016 found, I also have some ranges that it doesn't seem to like. Adding to his is J9-11 and C7-11 or pretty much anything that starts with a letter and 7 or 9 and is a range 7-11, 9-13 etc.

any ideas how to resolve this?

Thanks!
 
Upvote 0

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

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