Text to rows and copy rows.

[interner]

I'm not completely sure if I am dreaming too big here, so please let me know if my idea is a bit ludiculous.

I have a spreadsheet that contains two columns (columns "O" and "P") with serial numbers in them. The serial numbers in these two columns are separated by commas.

I wrote some script to calculate how many commas are in these last two columns. I stored this number in a variable named 'commas' as such.

Lastcell = Cells(Rows.Count, "O").End(xlUp).Row
For i = Lastcell To 1 Step -1
If (Cells(i, "O").Value) <> "" And Rows(i).EntireRow.Hidden = False_ Then
commas = Len(Cells(i, "O").Value) - Len(Replace(Cells(i, "O").Value, ",", ""))

So, I have my 'commas' variable. What I would like to do is perform a "text to rows" sorta deal. I'm trying to give each serial number its own unique row but have it contain the same information as the columns that come before it. The comma would be used as my delimiter in this particular case.

This process needs to be performed for column "O" first then column "P."

So the jest of it, each serial number (in column "O") gets its own row, and the information stored in columns 'A' through 'N' is right there with it. Then this process needs repeated for column 'P' whilst preserving the the information in columns 'A' through 'N' again.

Needless to say, any help would be greatly appreciated. If any clarification is needed please say so.

 

[interner]

i got it



Sub testerrr()


Dim cell1 As Range
With ActiveSheet
Last32 = Cells(Rows.Count, "O").End(xlUp).Row
For j = Last32 To 1 Step -1
If (Cells(j, "O").Value) <> "" And Rows(j).EntireRow.Hidden = False_ Then
reospeedwagon = Len(Cells(j, "O").Value) - Len(Replace(Cells(j, "O").Value, ",", ""))
End If
Next j
thelast = ActiveSheet.UsedRange.Rows.Count + reospeedwagon + 50
For i = 1 To thelast
Set cell1 = .Range("O" & i)
If Intersect(cell1, .Cells.SpecialCells(xlCellTypeVisible), .Cells.SpecialCells(xlCellTypeConstants)) Is Nothing Then
GoTo LabelNext:
Else:
comma = Len(cell1.Value) - InStr(cell1.Value, ",")
If comma = Len(cell1.Value) Then
GoTo LabelNext:
End If
cell1.Offset(1, 0).EntireRow.Insert
.Rows.Range("A" & cell1.Row & ":N" & cell1.Row).Copy
.Range("A" & cell1.Row + 1).Select
.Paste
.Cells(cell1.Row + 1, cell1.Column).Value = Right(cell1.Value, comma - 1)
temp = Left(cell1.Value, Len(cell1.Value) - comma - 1)
cell1.Value = temp
End If
LabelNext:
Next i
End With
With ActiveSheet
Last32 = Cells(Rows.Count, "P").End(xlUp).Row
For j = Last32 To 1 Step -1
If (Cells(j, "P").Value) <> "" And Rows(j).EntireRow.Hidden = False_ Then
reospeedwagon = Len(Cells(j, "P").Value) - Len(Replace(Cells(j, "P").Value, ",", ""))
End If
Next j
thelast = ActiveSheet.UsedRange.Rows.Count + reospeedwagon + 50
For i = 1 To thelast
Set cell1 = .Range("P" & i)
If Intersect(cell1, .Cells.SpecialCells(xlCellTypeVisible), .Cells.SpecialCells(xlCellTypeConstants)) Is Nothing Then
GoTo LabelNext2:
Else:
comma = Len(cell1.Value) - InStr(cell1.Value, ",")
If comma = Len(cell1.Value) Then
GoTo LabelNext2:
End If
cell1.Offset(1, 0).EntireRow.Insert
.Rows.Range("A" & cell1.Row & ":N" & cell1.Row).Copy
.Range("A" & cell1.Row + 1).Select
.Paste
.Cells(cell1.Row + 1, cell1.Column).Value = Right(cell1.Value, comma - 1)
temp = Left(cell1.Value, Len(cell1.Value) - comma - 1)
cell1.Value = temp
End If
LabelNext2:
Next i
End With