Macro VBA Script Needed

[Anthony123]

Hello, I REALLY need help soon! I have an Inventory Excel Spredsheet where i need to parse the data in a column. I need to create a Macro to do this. I have to parse this data into 'First Name' , and 'Last Name' (I ONLY NEED THE NAMES, all other data is irrelevant) and does not have to be parsed but my data is inconsistant so i just can't just parse where there is a space or colon. If there is a "Jr' or 'II' or any other name after the last name, it should be grouped with the 'Last Name' My data looks similar to this:

Column A
ND
ND
Assigned: Jim Scott Jr - Rm 279
Assigned: Joe M Smith - Rm 990
ND
ND
Stored: Room 432
Extra: Room 123
Assigned: Tony Tone II - Rm 356
Assigned: Susie Q Young -Rm 394
Stored: Room 563
Stored: Room 789
Extra: Room 654
ND
Assigned: Jimmy Joe Jr - Rm 276


Please let me know if you need any questions answered! I am on a tight deadline so any start will help! Thanks so much in adavnce!

 

[Gideon1973]

Welcome to the board!

Something like this should get you close:

=IF(NOT(ISERROR(FIND("Assigned:",A2,1))),TRIM(MID(A2,10,(LEN(A2)-FIND("- Rm",A2,9)+6))), "")

Not VBA -- actually an Excel formula. This will get you the parsed out full name, but you can probably split the first/last name fairly easily after that. You didn't mention what to do if you encounter middle names, middle initials, hyphenated names, etc. so you may want to tailor this function to meet your exact needs.

HTH!

 

[Anthony123]

Thank you Gideon 1973! This will help. I was looking for a macro because i will need to perform this operation several times in the future with different spread sheets. The middle names can be placed in a seperate column, or just ignored all together (but i wasnt sure how to do this).

 

[JLGWhiz]

The destination for the parsed names was not specified, so I provided for the insertion of two new columns for columns B and C. If you don't want that, just copy the names to where you want them and delete the columns.

Code:
Sub parse()
Dim sh As Worksheet, lr As Long, rng As Range
Dim Nm As String, num As Long, FNm As String, LNm As String, strt As Long
Set sh = Sheets(1) 'Edit sheet name
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh.Range("A2:A" & lr)
Columns("B:C").Insert
For Each c In rng
If LCase(Left(c.Value, 8)) = "assigned" Then
num = InStr(c.Value, "-") - InStr(c.Value, ":")
strt = InStr(c.Value, ":") + 1
Nm = Mid(c.Value, strt, num)
Nm = LTrim(Nm)
FNm = Left(Nm, InStr(Nm, " ") - 1)
LNm = Mid(Nm, (Len(FNm) + 1), Len(Nm) - (Len(FNm) + 2))
sh.Cells(Rows.Count, 2).End(xlUp)(2) = FNm
sh.Cells(Rows.Count, 3).End(xlUp)(2) = LNm
End If
Next
End Sub
Code:

 

[Anthony123]

Thank you! Works great!

 

[JLGWhiz]

It will work as long as the configuration of the text remains consistent. It he colon or dash are removed or another of either is added, the code fails.

Regards, JLG