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.

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

Ask Your Question

Weekly Poll

Do you think Monopoly should update its pieces?

Discuss in The Lounge

Poll History