Format Code to Output New Rows for Number Expansion - vba

Question

I have this code
Sub ExpandRanges()
Dim X As Long, CG As Variant, Rng As Range, Cell As Range
Dim Series As String, CommaGroups() As String, DashGroups() As String
Set Rng = Range(Range("H2"), Cells(Rows.Count, "H").End(xlUp))
For Each Cell In Rng
CommaGroups = Split(Cell, ",")
For Each CG In CommaGroups
DashGroups = Split(CG, "-")
For X = DashGroups(0) To DashGroups(UBound(DashGroups))
Series = Series & ", " & X
Next
Next
Cell.Offset(, 1).Value = Mid(Series, 3)
Series = ""
Next
End Sub
That gives me and output of:
Can anyone reformat the code to where it creates a new row for each number that is expanded from the range? Rather than expanding them out into a new column to where I have to separate them again manually.
I would like for it to look like this (referring to the first range)

Answer 1

Try this:
EDIT: Fixed
Sub ExpandRanges()
Dim X As Long, CG As Variant, Rng As Range, Cell As Range
Dim Series As String, CommaGroups() As String, DashGroups() As String
Dim j As Long, lastrow As Long, newrow as Long
j = 0
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
newrow = InputBox("What is the row number of your new range?")
Set Rng = Range(Range("H" & newrow), Range("H" & lastrow))
For Each Cell In Rng
CommaGroups = Split(Cell, ",")
For Each CG In CommaGroups
DashGroups = Split(CG, "-")
For X = DashGroups(0) To DashGroups(UBound(DashGroups))
If j = 0 Then j = Split(Cell.Address, "$")(2)
Rows(j + 1 & ":" & j + 1).Insert Shift:=xlDown
Cells(j, 9).Value = X
Range("C" & j + 1 & ":H" & j + 1).Value = Range("C" & j & ":H" & j).Value
j = j + 1
Next
Next
Next
'Band-aid solution
lastrow = Cells(Rows.Count, "H").End(xlUp).Row
Range("C" & lastrow & ":H" & lastrow).ClearContents
End Sub