Data to column by bold letters

[Guest]

Hello!
I have this column with names and titles:
This great person (bold) System Developer Specialist (not bold)

Can I devide this into two columns with the bold names and the titles not
bold in the other column.

Best regards
/Henrik

 

[Guest]

Assumes you won't have any formulas which will be messed up by inserting and
deleting columns.

Sub SplitBold()
Dim cell As Range
Dim l As Long, i As Long
Dim j As Long
Set rng = Range(Cells(1, "A"), Cells(1, "A").End(xlDown))
rng.EntireColumn.Offset(0, 1) _
.Resize(, 2).Insert
rng.EntireColumn.Offset(0, 1) _
.Resize(, 2).Font.Bold = False
For Each cell In rng
l = Len(cell)
For i = 1 To l
If cell.Characters(i, 1).Font.Bold Then
j = i
Else
Exit For
End If
Next
cell.Offset(0, 1).Value = Trim(Left(cell, j))
cell.Offset(0, 2).Value = Trim(Mid(cell, j + 1, l))
cell.Offset(0, 1).Font.Bold = True
Next cell
rng.EntireColumn.Delete
End Sub

 

[Guest]

This script only works for the first row.
All other data gets lost, about a 1000 records.
No harm done of course, but the script does not work.
Any ideas?
regards /Henrik