jeffcoleky
Active Member
- Joined
- May 24, 2011
- Messages
- 274
The goal is to turn This:
Excel 2010
<tbody>
</tbody>
Excel 2010
<tbody>
</tbody>
This is a great macro and it has worked great for me but now our needs have changed and I need formulas to be used in columns B, C, D, & E instead of the macro. Can anyone help me convert it?
EXCEL FILE HERE:http://goo.gl/ZY1xI
Excel 2010
A | |
---|---|
1 | Names Pre-Split |
2 | Armstrong Charles A Sr |
3 | Brackney Michael & Robin |
4 | Capland Yosef & Chava N |
5 | Fowler Kenneth |
6 | Kimbrough Vanessa G |
7 | Thammachart Suwanit & Gagel Tabitha |
<tbody>
</tbody>
Sheet1
Into This:Excel 2010
B | C | D | E | |
---|---|---|---|---|
1 | First Name 1 | Last Name 1 | First Name 2 | Last Name 2 |
2 | Charles | Armstrong | ||
3 | Michael | Brackney | Robin | Brackney |
4 | Yosef | Capland | Chava | Capland |
5 | Kenneth | Fowler | ||
6 | Vanessa | Kimbrough | ||
7 | Suwanit | Thammachart | Tabitha | Gagel |
<tbody>
</tbody>
Sheet1
Here is the MACRO that does this for me: (Note, the macro also adds columns for middle names/initials which I wish to exclude as well)
Code:
Sub Last_First_Split()
Dim rng As Range, cell As Range, Names As Variant, NameParts As Variant
Set rng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
rng.Offset(, 1).Resize(, 6).ClearContents
For Each cell In rng
If cell.Value <> "" Then
Names = Split(Application.WorksheetFunction.Trim(cell.Value), " & ")
' Single name or 1st of Couple
NameParts = Split(Names(0), " ")
cell.Offset(, 1).Value = StrConv(NameParts(1), vbProperCase)
If UBound(NameParts) = 2 Then cell.Offset(, 2).Value = StrConv(NameParts(2), vbProperCase)
cell.Offset(, 3).Value = StrConv(NameParts(0), vbProperCase)
' 2nd name if Couple
If UBound(Names) > 0 Then
NameParts = Split(Names(1), " ")
If UBound(NameParts) = 0 Then
' Pat
cell.Offset(, 4).Value = StrConv(NameParts(0), vbProperCase)
cell.Offset(, 6).Value = cell.Offset(, 3).Value
ElseIf UBound(NameParts) = 1 And Len(NameParts(1)) = 1 Then
' Pat E
cell.Offset(, 4).Value = StrConv(NameParts(0), vbProperCase)
cell.Offset(, 5).Value = UCase(NameParts(1))
cell.Offset(, 6).Value = cell.Offset(, 3).Value
Else
' Jones Sarah or Jones Sarah A
cell.Offset(, 4).Value = StrConv(NameParts(1), vbProperCase)
If UBound(NameParts) = 2 Then cell.Offset(, 5).Value = StrConv(NameParts(2), vbProperCase)
cell.Offset(, 6).Value = StrConv(NameParts(0), vbProperCase)
End If
End If
End If
Next cell
Application.ScreenUpdating = True
End Sub
This is a great macro and it has worked great for me but now our needs have changed and I need formulas to be used in columns B, C, D, & E instead of the macro. Can anyone help me convert it?
EXCEL FILE HERE:http://goo.gl/ZY1xI