Split names and dates within the same cell into 2 different cells (using multiple delimiters)-CodePudding

I have single (merged) cells that have this pattern:

FirstName (possible MiddleName) LastName (" " OR ", " OR " / ") DD/MM/YY

For example:

John Doe 21/01/2022
John Johasson Doe, 21/01/2022
etc...

I would like to split such cell using VBA and pasting the full name and the date into their own individual cells

The main delimiter here seems to be the date sinceit starts with a number since names can't takes those but I'm not sure how to achieve splitting the cell content.

So far I was using this:

Workbooks(workbook1).Worksheets("sheet").Range("whatever cell num").Value = Split(Workbooks(workbook2).Worksheets("sheet").Range("whatever cell num").Value, ", ")(0)
    Workbooks(workbook1).Worksheets("sheet").Range("whatever cell num").Value = Split(Workbooks(workbook2).Worksheets("sheet").Range("whatever cell num").Value, ", ")(1)

It used to work fine for its purpose until I started coming across signatures that don't involve commas to separate names and dates

Is there a solution that doesn't involve creating a function a looping through the string?

CodePudding user response：

This macro

splits off the last space separated segment which is the date
- Do this by reversing the string, then splitting into two.
- split the date by the "/", and create a date variable
Remove any commas that may or may not be in the string
write the results next to the original
- minor coding changes would enable overwriting the original

Note: if speed is an issue due to the number of rows in the worksheet, this should be rewritten using VBA arrays instead of repeated worksheet cell references

Sub SplitIt()
    Dim rg As Range
    Dim c As Range
    Dim v As Variant, w As Variant
    Dim sName As String, dt As Date
    
With ThisWorkbook.Worksheets("Sheet5")
    Set rg = Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp))
End With

For Each c In rg
    v = Split(StrReverse(c), " ", 2)
    w = Split(StrReverse(v(0)), "/")
    dt = DateSerial(w(2), w(1), w(0))
    sName = Replace(StrReverse(v(1)), ",", "")
    
    With c
        .Offset(0, 1).Value = sName
        .Offset(0, 2).Value = dt
    End With
Next c
End Sub

CodePudding user response：

A different way using InStrRev.

Sub Split_Name_Date_test()

Dim sh As Worksheet

Dim c As Range

Set sh = ThisWorkbook.Worksheets("Sheet1")

LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row

For i = 1 To LastRow
    Set c = sh.Cells(i, "A")

    TheText = Trim(c.Value)
    LastSpace = InStrRev(TheText, " ")
    TheName = Trim(Mid(TheText, 1, LastSpace))
    TheDate = Mid(TheText, LastSpace   1)

    c.Offset(0, 1).Value = TheName
    c.Offset(0, 2).Value = "'" & TheDate
Next i

End Sub