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(R eplace(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.