Macro - text to column and copy the information in the next row and loop until finish

[sharontlf]

Hi, can you please help to create macro, see example below:

In column G, 1st row is contains more than 1 data (343376, 487381), therefore, i need this to split and copy down the same information in another row.
Can you help on this...


Original:

Column A Column B Column C Column D Columm E Column F Column G
Australia A.C.N. GB 0000418 GBC 0001738 343376, 487381
Australia A.P.M. GB 0000418 GBN 0001747 169038

Result:

Column A Column B Column C Column D Columm E Column F Column G
Australia A.C.N. GB 0000418 GBC 0001738 343376
Australia A.C.N. GB 0000418 GBC 0001738 487381
Australia A.P.M. GB 0000418 GBN 0001747 169038

[NickyC]

Hi
is 343376, 487381 in cell G1, or is 343376 in G1 and 487381 in H1
if the former, are they always in column G, and are they always separated by a comma and space
uploading a workbook with an example of what you want might help

[sharontlf]

Hi, is 343376, 487381 in cell G1. I attached the file already. Thanks

[NickyC]

Hi
try this macro

Sub split_cells()
Dim ArrNos As Variant, RowNum As Long, x As Long, y As Long
RowNum = 2
Do While Rows(RowNum).Columns("G").Value <> ""
    ArrNos = split(Rows(RowNum).Columns("G").Value, ",")
    If UBound(ArrNos) > 0 Then
        Rows(RowNum).Columns("G").Value = ArrNos(0)
        For x = 1 To UBound(ArrNos)
          RowNum = RowNum + 1
          Rows(RowNum).EntireRow.Insert
          Rows(RowNum).Columns("G").Value = ArrNos(x)
          For y = 1 To 6
            Rows(RowNum).Columns(y) = Rows(RowNum - 1).Columns(y)
            'Rows(RowNum).Columns(y).NumberFormat = Rows(RowNum - 1).Columns(y).NumberFormat
          Next y
        Next x
    End If
    RowNum = RowNum + 1
Loop
End Sub

[sharontlf]

Hi Nicky, i find there is some blank space in result column G. Can we use TRIM formula to incorporate in ur macro to remove it?

[NickyC]

yes - try this:

Sub split_cells()
Dim ArrNos As Variant, RowNum As Long, x As Long, y As Long
RowNum = 2
Do While Rows(RowNum).Columns("G").Value <> ""
    ArrNos = Split(Rows(RowNum).Columns("G").Value, ",")
    If UBound(ArrNos) > 0 Then
        Rows(RowNum).Columns("G").Value = Trim(ArrNos(0))
        For x = 1 To UBound(ArrNos)
          RowNum = RowNum + 1
          Rows(RowNum).EntireRow.Insert
          Rows(RowNum).Columns("G").Value = Trim(ArrNos(x))
          For y = 1 To 6
            Rows(RowNum).Columns(y) = Rows(RowNum - 1).Columns(y)
            'Rows(RowNum).Columns(y).NumberFormat = Rows(RowNum - 1).Columns(y).NumberFormat
          Next y
        Next x
    End If
    RowNum = RowNum + 1
Loop
End Sub