Split multiple numbers in one cell into individual cells

[CEsli]

Hello everyone,

I need to write a macro in VB that separates data in one cell (which may contain numbers separated by commas and dashes) into individual cells in a column. I believe the cells are formatted as text if that makes a difference. A code within a for loop would be preferable since it will have to loop through a varying number of rows.

For example: (A1) 1-3,8-10 needs to be separated into (B1) 1, (B2) 2, (B3) 3, (B4) 8, (B5) 9, (B6) 10.

Any help would be much appreciated!

 

[Rick Rothstein]

Give this code a try (copy all of it to a general module... you execute the ExpandDashedSeries macro, it calls the PagesToPrint function as needed)...

[table="width: 500"]
[tr]
	[td]Sub ExpandDashedSeries()
  Dim R As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
  For R = 1 To UBound(Data)
    Data(R, 1) = PagesToPrint(Data(R, 1))
  Next
  Range("B1").Resize(UBound(Data)) = Data
  Columns("B").TextToColumns , xlDelimited, , , False, False, True, False, False
End Sub


Function PagesToPrint(sInput As Variant) As Variant
  Dim X As Long, Z As Long, Temp As String, sNumbers() As String, sRange() As String
  If sInput Like "*# #*" Then GoTo Bad
  sInput = Replace(sInput, " ", "")
  If sInput Like "*[!0-9,-]*" Or sInput Like "*[,-][,-]*" Or _
     Not sInput Like "*#" Or Not Val(sInput) Like "[1-9]*" Then GoTo Bad
  sNumbers = Split(sInput, ",")
  For X = 0 To UBound(sNumbers)
    If sNumbers(X) Like "*-*" Then
      If sNumbers(X) Like "*-*-*" Then GoTo Bad
      sRange = Split(sNumbers(X), "-")
      sNumbers(X) = ""
      For Z = sRange(0) To sRange(1) Step Sgn(sRange(1) - sRange(0) + 0.1)
        sNumbers(X) = sNumbers(X) & "," & Z
      Next
      sNumbers(X) = Mid(sNumbers(X), 2)
    Else
      sNumbers(X) = Val(sNumbers(X))
    End If
  Next
  PagesToPrint = Join(sNumbers, ",")
  Exit Function
Bad:
  PagesToPrint = Array()
  MsgBox """" & sInput & """" & vbLf & vbLf & "The specified range of values is incorrectly formed!", vbCritical
End Function[/td]
[/tr]
[/table]

 

[CEsli]

Give this code a try (copy all of it to a general module... you execute the ExpandDashedSeries macro, it calls the PagesToPrint function as needed)...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub ExpandDashedSeries()
  Dim R As Long, Data As Variant
  Data = Range("A1", Cells(Rows.Count, "A").End(xlUp)).Value
  For R = 1 To UBound(Data)
    Data(R, 1) = PagesToPrint(Data(R, 1))
  Next
  Range("B1").Resize(UBound(Data)) = Data
  Columns("B").TextToColumns , xlDelimited, , , False, False, True, False, False
End Sub


Function PagesToPrint(sInput As Variant) As Variant
  Dim X As Long, Z As Long, Temp As String, sNumbers() As String, sRange() As String
  If sInput Like "*# #*" Then GoTo Bad
  sInput = Replace(sInput, " ", "")
  If sInput Like "*[!0-9,-]*" Or sInput Like "*[,-][,-]*" Or _
     Not sInput Like "*#" Or Not Val(sInput) Like "[1-9]*" Then GoTo Bad
  sNumbers = Split(sInput, ",")
  For X = 0 To UBound(sNumbers)
    If sNumbers(X) Like "*-*" Then
      If sNumbers(X) Like "*-*-*" Then GoTo Bad
      sRange = Split(sNumbers(X), "-")
      sNumbers(X) = ""
      For Z = sRange(0) To sRange(1) Step Sgn(sRange(1) - sRange(0) + 0.1)
        sNumbers(X) = sNumbers(X) & "," & Z
      Next
      sNumbers(X) = Mid(sNumbers(X), 2)
    Else
      sNumbers(X) = Val(sNumbers(X))
    End If
  Next
  PagesToPrint = Join(sNumbers, ",")
  Exit Function
Bad:
  PagesToPrint = Array()
  MsgBox """" & sInput & """" & vbLf & vbLf & "The specified range of values is incorrectly formed!", vbCritical
End Function[/TD]
[/TR]
</tbody>[/TABLE]

Hi Rick, thanks for you reply. The code is giving me a type-mismatch error for the following line:

For R = 1 To UBound(Data)

I was also wondering how I could potentially resize the selection from 1 column to 3. For instance, cell (A1) could have 1-3,8-10 (as mentioned previously), but cell (B1) and (C1) could also have data (single numbers, numbers in a range separated by a dash or comma, etc.). Specifically, I need to code to print those numbers in what would be column D, based on the data extracted from A-C. Thanks again.

 

[Rick Rothstein]

Hi Rick, thanks for you reply. The code is giving me a type-mismatch error for the following line:

For R = 1 To UBound(Data)

I'll get to your other question once we solve the above problem. My code assumes you values are in Column A of the active sheet starting on Row 1. The only way I could think to produce that error is if Column A was empty. Was there any data in Column A of the active sheet when you ran my code and got that error message?