I have been tasked with some string manipulation and today must be my bad head day as it is proving more difficult than I expected.
I have to take the initials of the first and second and third name from the first and second and third columns along with any surnames
Plus we need to keep the title.
Here is an example of the long name as it stands now:
Mr C Chrysostomou & Mr N Chrysostomou & Mrs A Chrysostomou
Mrs M Karseras & Ms P Hadjisoteriou & Mrs E Athanasiou
Mrs A Theodorou & Mr A Aristotelou & Mrs G Naziri & M Karmiou Mrs L Vazanias & Mrs G
Braithwaite & Mrs Helen West Mrs L Vazanias & Mrs G Braithwaite & Mrs
Helen West Mrs Olympia Pieridou & Mrs T&mr M & Mr C & Mrs K
Michaelides Miss JA Santamas& Mrs MT Santama- Solomonides& Mrs Lida
Santama Miss JA Santamas& Mrs MT Santama- Solomonides& Mrs Lida
Santama Mr Polydoros Polydorou & Mrs Maro Themistocleous & Mrs Sylvia
Polydorou Mr Themis & Mrs Androulla & Mr Nicholas & Mrs Vasso Gina
Demetriou Mrs SK Makkofaides & Mr Z Koullas & Mrs Y Koullas & Mrs R
Kleopa Mr G Zorzy & Mrs H Louca Zorzy & Mr S Stavropoulos & Mrs Y
Stavropoulos Mrs M Franceschina & Ms C Eugeniou & Ms OL Toumazides
T/a The Three Cupcakes Mr David & Mrs Eileen Nixon Dhnixon & Co. - Office Account
as you can see, these could be considered to be joint bank accounts between 2 or even 3 persons. we will have to keep the tite, which could be Mr, Miss, Ms, Dr, Doctor , or Messrs along with the initials of the first and second names and the full surname, and the total should be less than 35 characters !
so, here is what I have been trying after some searching on the web:
=IF(LEN(TRIM(E:E))-LEN(SUBSTITUTE(TRIM(E:E)," ",""))>=1,MID(TRIM(E:E),FIND(" ",TRIM(E:E))+1,1),"")& " " &IF(LEN(TRIM(E:E))-LEN(SUBSTITUTE(TRIM(E:E)," ",""))>=2,MID(SUBSTITUTE(TRIM(E:E)," ","",1),FIND(" ",SUBSTITUTE(TRIM(E:E)," ","",1))+1,1),"")
that gets the initials, but only the first 2
=RIGHT(J:J,LEN(J:J)-FIND(" ",J:J)+1)
gets the surname but isn't working correctly.
am I over thinking this, or under thinking it?
What is my best approach to the data?
thanks Philip
This should get you started.
Lets say your data looks like this
Paste this code in a module. (Note: This code is not extensively tested but conveys the message)
Option Explicit
Sub Sample()
Dim MyAr As Variant
Dim FinalAr() As String, TmpAr() As String
Dim ws As Worksheet
Dim lrow As Long, i As Long, n As Long, j As Long
'~~> Set this to the relevant sheet
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
'~~> get last row of col A
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Store the values in an array
MyAr = .Range("A1:A" & lrow)
'~~> Loop through the array and split it on "&" and store it in another array
For i = LBound(MyAr) To UBound(MyAr)
If InStr(1, MyAr(i, 1), "&") Then
TmpAr = Split(MyAr(i, 1), "&")
For j = LBound(TmpAr) To UBound(TmpAr)
n = n + 1
ReDim Preserve FinalAr(n)
FinalAr(n) = Trim(TmpAr(j))
Next j
Else
n = n + 1
ReDim Preserve FinalAr(n)
FinalAr(n) = Trim(MyAr(i, 1))
End If
Next i
'~~> Past the outcome in Col B
.Range("B1").Resize(UBound(FinalAr) + 1, 1).Value = Application.Transpose(FinalAr)
'~~> Replace all mrs/mr etc
.Columns(2).Replace What:="MRS", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns(2).Replace What:="MR", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Columns(2).Replace What:="MISS", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'~~> Find Last Row of Col B
lrow = .Range("B" & .Rows.Count).End(xlUp).Row
'~~> Loop through col B and split the names
For i = 2 To lrow
If InStr(1, .Range("B" & i), " ") Then
TmpAr = Split(Trim(.Range("B" & i)), " ")
n = 1
For j = LBound(TmpAr) To UBound(TmpAr)
.Range("B" & i).Offset(, n).Value = TmpAr(j)
n = n + 1
Next
Else
.Range("C" & i).Value = .Range("B" & i).Value
End If
Next i
End With
End Sub
OutCome (Screenshot)
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.