To Copy and Split the Name to First and Surname from Another Workbook

[nelsontan]

<div>I am new to VBA coding, I want to copy and split the full name directly from Workbook A to workbook B, but the problem is not all the name has the dot (.) in between, I've tried to copy and modify some codes from this forum which split the name within the same workbook but it doesn't work for my case. Kindly refer to below summary which showing the result I wanted. Thanks in advance :crying:

28690

[jolivanes]

The destination workbook (MacroBook.xlsm) needs to be open also.
Change all references (workbook names, sheet names, cell addresses) as required.

Sub Maybe()
Dim nms, i As Long
Dim wbT As Workbook, wbDest As Workbook
Dim shT As Worksheet, shDest As Worksheet
Set wbT = ThisWorkbook
Set wbDest = Workbooks("TempBook2.xlsm") '<---- Change as required
Set shT = wbT.Sheets("Sheet1") '<---- Change as required
Set shDest = wbDest.Sheets("Sheet1") '<---- Change as required
nms = shT.Range("A1:A" & shT.Cells(Rows.Count, 1).End(xlUp).Row).Value
ReDim Preserve nms(1 To UBound(nms), 1 To 2)
For i = LBound(nms) To UBound(nms)
If InStr(nms(i, 1), ".") <> 0 Then
nms(i, 2) = Mid(nms(i, 1), InStr(nms(i, 1), ".") + 1, 99)
nms(i, 1) = Left(nms(i, 1), InStr(nms(i, 1), ".") - 1)
End If
Next i
shDest.Cells(1, 1).Resize(UBound(nms), 2).Value = nms
End Sub
This only works on what you supplied in Post #1.

[nelsontan]

Thanks for the codes, I have modified it to suit my needs, thank you so much :bow::bow:



'declare variable Dim nms, i As Long
Dim lastRow1 As Long
Dim lastRow2 As Long

'Set Macro file
Set wbmacrobook = ThisWorkbook


'Open raw file
vfile = Application.GetOpenFilename("Excel File (*.xlsx;*csv)," & "*.xlsm*" & "*.csv*", 1, "Select Excel File", "Open", False)

'If Cancel then Exit
If TypeName(vfile) = "Boolean" Then
Application.ScreenUpdating = True
'Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Exit Sub
Else
Set wbrawfile = Workbooks.Open(vfile)
Application.AskToUpdateLinks = False
End If

'To copy from raw file and split the name
wbrawfile.Activate
nms = Sheets("Promaster").Range("A2:A" & Sheets("Promaster").Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim Preserve nms(1 To UBound(nms), 1 To 2)
For i = LBound(nms) To UBound(nms)
If InStr(nms(i, 1), ".") <> 0 Then
nms(i, 2) = Mid(nms(i, 1), InStr(nms(i, 1), ".") + 1, 99)
nms(i, 1) = Left(nms(i, 1), InStr(nms(i, 1), ".") - 1)
End If
Next i

wbmacrobook.Activate
Sheets("Promaster").Cells(2, 1).Resize(UBound(nms), 2).Value = nms




'Find last row in column A with data
'Copy remaing columns
wbrawfile.Activate
lastRow1 = Cells(Rows.Count, "A").End(xlUp).Row
Range("F2:V" & lastRow1).Copy

wbmacrobook.Activate
lastRow2 = Cells(Rows.Count, "A").End(xlUp).Row + 1
Sheets("Promaster").Range("D2:T" & lastRow2).PasteSpecial Paste:=xlPasteValues

[jolivanes]

Glad you got it working.
Good Luck

[nelsontan]

After checked all my data, I realised that there are some names which needed special care, example as below, is it possible to have the VBA codes to tackles all situation below?

1. Ronald.Jarvis (Existing)
2. Richard (Existing)
3. Robert.Downey.JR (New) - To split to Robert (First Name), Downey (Last Name) only
4. Chris Hermsworth (New) - Space between name instead of dot (.)

[SamT]

Add "Dim nm" and "Dim j"to Procedure


ReDim Preserve nms(1 To UBound(nms), 1 To 2)
For i = LBound(nms) To UBound(nms)
nm = nms(i, 1)
nm = Replace(nm, " ", " ") 'Replace double spaces in Names

'Only one name
If Not (Cbool(Instr(nm), " ")) Or Cbool(Instr(nm), "."))) Then 'Add test for commas, if used
nms(i, 1) = Trim(nm)
Goto iNext
End If

'Has 1 or more periods. Double Last Names OK
If CBOOL(InStr(nm, ".")) Then
nms(i, 1) = Trim(Split(nm), ".")(0))
nms(i, 2) = Trim(Split(nm, ".")(1))
Goto iNext
End If

'Just in case Has commas. Also an example for OP
If CBOOL(InStr(nm, ",")) Then
nms(i, 1) = Trim(Split(nm), ",")(1))
nms(i, 2) = Trim(Split(nm, ",")(1))
Goto iNext
End If

'More than one name, has no periods or commas
nms(i, 1) = Trim(Split(nm)(0))
For j = 1 to Ubound(Split(nm)) 'to handle double last names without periods or commas
nms(i, 2)= Trim(nms(i, 2) & " " & Split(nm)(j))
Next j
inext:
Next i


I think that has got it all. Not tested, obviously.