Revisiting Redistribute a Delimited Column Of Data into Separate Rows

[leukram]

Hi. I am trying to use your macro Redistribute a Delimited Column Of Data into Separate Rows (Keeping Other Data As Is). It is almost perfect for a task that I need to automate. Your code separates comma delimited data, and I modified it to look for hyphen delimited, which is the limit to my coding abilities. So, for example, I have data that has a range, like a page range 4-7. Your macro splits it into a row with 4 and a row with 7, keeping the other data. Is there a way to get it to create the rows within the range as well. For example for the range 4-7, could it create a row for 4, a row for 5, a row for 6, and a row for 7 (keeping the other data intact)? Better yet, is it possible to combine this code with your code for Generalized Series Expansions to create a super tool that can handle almost anything and separate them into individual rows. I have very little coding knowledge, so quite frankly, I am humbly asking if it would be possible for you to find some time to modify your code. If you need any other information, please let me know. Thanks for your time.

[Excel Fox]

I'm sure Rick will get back to you once he gets the time. Meanwhile, did you achieve your objective with the two individual codes from Rick?

[Rick Rothstein]

Better yet, is it possible to combine this code with your code for Generalized Series Expansions to create a super tool that can handle almost anything and separate them into individual rows. I have very little coding knowledge, so quite frankly, I am humbly asking if it would be possible for you to find some time to modify your code.

Easy enough to do, simply include the ExpandedSeries function in the same module as the RedistributeData macro and modify one line of code (highlighted in red below) in the RedistributeData macro to accommodate the call to the ExpandedSeries function...

Sub RedistributeData()
  Dim X As Long, LastRow As Long, A As Range, Table As Range, Data() As String
  Const Delimiter As String = ", "
  Const DelimitedColumn As String = "C"
  Const TableColumns As String = "A:C"
  Const StartRow As Long = 2
  Application.ScreenUpdating = False
  LastRow = Columns(TableColumns).Find(What:="*", SearchOrder:=xlRows, _
            SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
  For X = LastRow To StartRow Step -1
    Data = Split(ExpandedSeries(Cells(X, DelimitedColumn), Delimiter), Delimiter)
    If UBound(Data) > 0 Then
      Intersect(Rows(X + 1), Columns(TableColumns)).Resize(UBound(Data)).Insert xlShiftDown
    End If
    If Len(Cells(X, DelimitedColumn)) Then
      Cells(X, DelimitedColumn).Resize(UBound(Data) + 1) = WorksheetFunction.Transpose(Data)
    End If
  Next
  LastRow = Cells(Rows.Count, DelimitedColumn).End(xlUp).Row
  On Error Resume Next
  Set Table = Intersect(Columns(TableColumns), Rows(StartRow).Resize(LastRow - StartRow + 1))
  If Err.Number = 0 Then
    Table.SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    Columns(DelimitedColumn).SpecialCells(xlFormulas).Clear
    Table.Value = Table.Value
  End If
  On Error GoTo 0
  Application.ScreenUpdating = True
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(-(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

Note: Leave the delimiters as I have them set... do not try to change them.

[leukram]

Thanks for looking at this. I pasted the code you posted into a module. When I run the macro, I get Runtime Error '13': Type mismatch. Any ideas on what is causing that? Thanks again for your time.

[leukram]

I'm sure Rick will get back to you once he gets the time. Meanwhile, did you achieve your objective with the two individual codes from Rick?

I did have some success, but there were a few combinations of range and comma delimited data that were not being processed.

[Rick Rothstein]

I did have some success, but there were a few combinations of range and comma delimited data that were not being processed.

If you show me a few of the values that are not working for you, then I can test them out on my system and see if I can figure out what the problem is.