Sub zzz()
    Dim objRegExp As Object, objMatch As Object
    Dim i%, j%, m%, n%, i1%
    i1 = Range("B" & Cells.Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For j = 3 To i1
    n = 0: m = 0
    Set objRegExp = CreateObject("VBScript.RegExp")
    With objRegExp: .IgnoreCase = True: .Global = True
     .Pattern = "(\d{3}\-\d{3}\-\d{2}\-\d+)([a-zA-Z ]+)"
    End With
        For Each objMatch In objRegExp.Execute(Range("B" & j))
         m = m + 1
         Range("C" & j).Offset(, m) = objMatch.SubMatches(0)
         n = n + 1
         Range("E" & j).Offset(, n) = Trim(objMatch.SubMatches(1))
        Next: Range("C" & j) = Range("F" & j)
        Range("F" & j) = Range("G" & j): Range("G" & j) = ""
        Next
       Application.ScreenUpdating = True
       Columns("H").ClearContents
End Sub