Cell contents separated by dash"-"

sainathd

New Member
Joined
Aug 29, 2017
Messages
16
Hi,
I have cell which contains C45-C90, I want it to split into multiple rows and fill in the form C45, C46,C47...C90

For example:

colAColB
C45-C500.6
C99-C1010.5

<tbody>
</tbody>

Expected Result

Col ACol BCol C
C45C45-C500.6
C460.6
C470.6
C480.6
C490.6
C500.6
C99




C99-C1010.5

<tbody>
</tbody>
C100 0.5
C1010.5

<tbody>
</tbody>


Hope it's clear, please help me if there is any way I would be able to accomplish this.
 
Last edited:

Marcelo Branco

MrExcel MVP
Joined
Aug 23, 2010
Messages
16,317
I'll use an excellent function provided by Rick Rothstein - see
Generalized Series Expansions (e.g. AB5-AB9 becomes AB5, AB6, AB7, AB8, AB9)

Before Macro

A
B
C
D
E
F
1
C45-C50​
0.6​
2
C99-C101​
0.5​
3

<tbody>
</tbody>


My code
Function by Rick Rothstein
Code:
Sub aTest()
    Dim rCell As Range, spl As Variant, lin As Long
    
    lin = 1
    For Each rCell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Cells(lin, "E") = rCell
        spl = Split(ExpandedSeries(rCell.Value), ", ")
        Range("D" & lin).Resize(UBound(spl) + 1) = Application.Transpose(spl)
        Range("F" & lin).Resize(UBound(spl) + 1) = rCell.Offset(, 1)
        lin = lin + UBound(spl) + 1
    Next rCell
End Sub

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(-(CLng(Numbers(1)) > CLng(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
After macro - results in columns D:F

A
B
C
D
E
F
1
C45-C50​
0.6​
C45​
C45-C50​
0.6​
2
C99-C101​
0.5​
C46​
0.6​
3
C47​
0.6​
4
C48​
0.6​
5
C49​
0.6​
6
C50​
0.6​
7
C99​
C99-C101​
0.5​
8
C100​
0.5​
9
C101​
0.5​
10

<tbody>
</tbody>


Hope this helps

M.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
42,231
Office Version
365
Platform
Windows
Another option to try on a copy of your workbook.
This also puts results in columns D:F.

Code:
Sub MakeSeries()
  Dim bits As Variant, data As Variant, result As Variant
  Dim firstnum As Long, lastnum As Long, i As Long, j As Long, k As Long
  Dim prefix As String
  
  data = Range("A1").CurrentRegion.Value
  ReDim result(1 To Rows.Count, 1 To 3)
  k = 1
  For i = 1 To UBound(data)
    bits = Split(data(i, 1), "-")
    firstnum = StrReverse(Mid(Val(StrReverse(bits(0) & 9)), 2))
    lastnum = StrReverse(Mid(Val(StrReverse(bits(1) & 9)), 2))
    prefix = Replace(bits(0), firstnum, "")
    result(k, 2) = data(i, 1)
    For j = firstnum To lastnum
      result(k, 1) = prefix & j: result(k, 3) = data(i, 2)
      k = k + 1
    Next j
  Next i
  Range("D1:F1").Resize(k - 1).Value = result
End Sub
 

sainathd

New Member
Joined
Aug 29, 2017
Messages
16
I'll use an excellent function provided by Rick Rothstein - see
Generalized Series Expansions (e.g. AB5-AB9 becomes AB5, AB6, AB7, AB8, AB9)

Before Macro

A
B
C
D
E
F
1
C45-C50​
0.6​
2
C99-C101​
0.5​
3

<tbody>
</tbody>


My code
Function by Rick Rothstein
Code:
Sub aTest()
    Dim rCell As Range, spl As Variant, lin As Long
    
    lin = 1
    For Each rCell In Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
        Cells(lin, "E") = rCell
        spl = Split(ExpandedSeries(rCell.Value), ", ")
        Range("D" & lin).Resize(UBound(spl) + 1) = Application.Transpose(spl)
        Range("F" & lin).Resize(UBound(spl) + 1) = rCell.Offset(, 1)
        lin = lin + UBound(spl) + 1
    Next rCell
End Sub

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(-(CLng(Numbers(1)) > CLng(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
After macro - results in columns D:F

A
B
C
D
E
F
1
C45-C50​
0.6​
C45​
C45-C50​
0.6​
2
C99-C101​
0.5​
C46​
0.6​
3
C47​
0.6​
4
C48​
0.6​
5
C49​
0.6​
6
C50​
0.6​
7
C99​
C99-C101​
0.5​
8
C100​
0.5​
9
C101​
0.5​
10

<tbody>
</tbody>


Hope this helps

M.

I worked like a charm, thanks.Also there is one more favor I'd like to ask.

I have series like C1,c2,c3,....c100,c101,c102,....c200,c201,c203....c301,c302,c303....etc
I wish to sort it however when I use regular sort by option I'll get c,c100,c101,c102..c2,c201.. you get the idea right?
But I want it to sort like c1,c2,c3,c4,c5,....c100,c101,c102....c201,c201...etc
Let me put it in table


C10.1
C1000.2
C1010.3
C20.4
C2010.5
C2010.6
C30.7
C3010.8
C3020.9
C3031

<tbody>
</tbody>

expected

c1
c2
c3
c4
c5
c6
c100
c101
c102
c103

<tbody>
</tbody>

The values in COL B should correspond to it COL A... You think will it possible to do?
 

Forum statistics

Threads
1,081,835
Messages
5,361,600
Members
400,640
Latest member
fruitbros

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top