Hi,
Here is one solution assuming that the format of all your strings look similar with the dashes, the spaces, etc...
Public Sub Extract_Words()
Dim r1 As Range
Dim last_row As Range
Set r1 = Range("A1")
Set last_row = r1.End(xlDown)
Set r1 = r1.Offset(1, 0)
Do While r1.Address <> last_row.Offset(1, 0).Address
r1.Offset(0, 1) = Mid(r1.Value, InStr(r1.Value, "_") + 1, InStr(r1.Value, "-") - InStr(r1.Value, "_") - 1)
Debug.Print r1.Offset(0, 1)
r1.Offset(0, 2) = Mid(r1.Value, InStr(r1.Value, "-") + 1, InStrRev(r1.Value, "-") - InStr(r1.Value, "-") - 1)
Debug.Print r1.Offset(0, 2)
r1.Offset(0, 3) = Left(r1.Value, InStr(r1.Value, " "))
Debug.Print r1.Offset(0, 3)
Set r1 = r1.Offset(1, 0)
Loop
End Sub
Bookmarks