Transpose single row containing semicolon separated values to column

Hi,

I have a network database which is in the following format:
the first column contains the source node and the second column contains all the nodes linked to that source node separated by semicolons.

For example, cell A1: 1 _ cell B1: 2; 3; 4; 9
[I'll use this notation: 1 -- 2; 3; 4; 9]

I need to convert this to:
1 -- 2
1 -- 3
1 -- 4
1 -- 9

Is there an easy way to do it?

Oh, the number of links varies.

Of course I could convert the text to columns and then manually transpose every single row, but the database is big and I'd like to find an automated way to do this.

Thank you very much!

Could you post a workbook with a small sample of data?

Sure! Here it is!

Example.xlsx

Three sheets: "What I have", "What I need" (first-best solution); "Acceptable" (second-best solution if first -best too difficult).

Thanks a lot!

Try this:

Sub x()

Dim r As Range, v

With Sheet1
    For Each r In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
        If Len(r.Offset(, 1)) > 0 Then
            v = Split(r.Offset(, 1), ";")
            Sheet2.Range("A" & Rows.Count).End(xlUp)(2).Resize(UBound(v) + 1) = r
            Sheet2.Range("B" & Rows.Count).End(xlUp)(2).Resize(UBound(v) + 1) = Application.Transpose(v)
        End If
    Next r
End With

Sheet2.Range("A1:B1") = Array("Source", "Target")

End Sub

Thank you very much for your quick reply, Stephen.

Unfortunately, it throws me runtime error 424 "Object required".

I don't know if I'm doing something wrong...

Thanks a lot.

It worked for me on your file. Which line errors?

Line 6: "For Each r ..."

That's odd. Are you trying this on a different file from the one you posted here?

No, exactly the same one..

Actually, the real thing I need is a bit more complicated: here's the "real" thing.

Example2.xlsx

Thanks!

Lordy, that's quite different, why didn't you post that in the first place?!

Hi Wilco,
will this work on the Mac

Sub ertert()
Dim x, y(), i&, j&, k&, n&, sp, s$
With Sheets("What I Have")
    x = .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row).Value
End With
ReDim y(1 To UBound(x) * 4, 1 To 3)
For i = 2 To UBound(x)
    If Len(Trim(x(i, 1))) Then
        sp = Split(x(i, 2), ";")
        For j = 0 To UBound(sp)
            n = n + 1: y(n, 1) = x(i, 1)
            y(n, 2) = Val(sp(j)): s = Split(sp(j), ",")(1)
            For k = 1 To 10
                If Application.Roman(k) = s Then y(n, 3) = k: Exit For
            Next k
            If k > 10 Then y(n, 3) = s
        Next j
    End If
Next i
With Sheets("What I need")
    .UsedRange.ClearContents
    .Range("A1:C1").Value = Array("Source", "Target", "Weight")
    .Range("A2:C2").Resize(n).Value = y()
    .Activate
End With
End Sub