Initials in a multiple-word cell

[Andresleo47]

Hi Mr. Excel fellas! Hoping you're doing well.

The following are some of the values that I have in a single column:

332241
4321 - P1 W2 John Smith
Balance for Alvin James Fox
12345 - P10 W4 Carl Sagan
12345

Now, I need to put the initials of the names in the next column, so, the output would be

-
JS
AJF
CS
-

Any thoughts?

This is something I would truly appreciate!

Thanks so much,

AV

 

[lrobbo314]

This does the same thing using VBA.

PQ VBA.xlsm
	A	B
1	3310672 - P7 W2 Jean Sebestien Pelletier.	J.S.P.
2	3310674 - P7 W2 Jean Sebestien Pelletier.	J.S.P.
3	3310678 - P7 W2 Natasha Trzebinski.	N.T.
4	3227881 - P1 W3 Jordan Houghton	J.H.
5	3326480 - P8 W3 Evaughn Heath	E.H.
6	3344673 - P9 W4 Katelyn Young	K.Y.
7	3264657 - P4W2 Josee Robitaille	J.R.
8	3228771 - P1 W3 Jean-Sebastien Giroux	J.G.
9	3331046 - P9 W2 Eric Diffey	E.D.
10	3331047 - P8 W4 Eric Diffey	E.D.
11	AA3181227
12	45848
13	129379
14	412978
15	117794
16	58702932
17	169217
18	67065
19	412445
20	4833
21	117794
22	2862117 - P13 W2 Matthew Saddleback	M.S.
23	2961899 - P02 W1 Hayden Matchee	H.M.
24	2878264 - P13 W3 Tyler Jacques	T.J.
25	2941274 - P01 W2 Reginald Siddall	R.S.
26	2911422 - P02 W3 Logan Gavey	L.G.
27	2914556 - P12 W4 Kaydence Wahsatnow	K.W.
28	2914549 - P12 W4 Ferleen Kakeesim	F.K.
29	2886711 - P01 W4 Cynthia Sagstven	C.S.
30	2912954 - P01 W1 Doris Laboucan	D.L.
31	2935906 - P13 W4 Jolene gray	J.G.
32	2975056 - P05 W1 Liza Jerome	L.J.
33	3012404 - P04 W4 joan McKinley	J.M.
34	3030481 - P05 W1 Valencia Del-hierro	V.D.
35	2954286 - Samantha Veltkamp	S.V.
36	2980489 - P02 W4 Mary Thomas	M.T.
37	2958912 - P01 W4 Barbara Shindeka	B.S.
38	2981640 - P04 W4 Ashton Aubichon-Corrigal	A.A.
39	3030488 - P05 W1 Valencia Del-hierro	V.D.
Sheet2

Cell Formulas
Range	Formula
B1:B39	B1	=it(A1)

Function IT(s As String)

If InStr(s, "-") > 0 Then
    s = Trim(Replace(Replace(Replace(Replace(s, "  ", " "), "(", ""), ")", ""), ".", ""))
    Dim SP() As String: SP = Split(Trim(Right(s, Len(s) - InStr(s, " - ") - 2)), " ")
    
    With CreateObject("System.Collections.ArrayList")
        For i = LBound(SP) To UBound(SP)
            If Not SP(i) Like "*[0-9]" Then .Add UCase(Left(SP(i), 1)) & "."
        Next i
        IT = Join(.toArray(), "")
    End With
Else
    IT = vbNullString
End If
End Function

 

[Andresleo47]

It works really well. Thanks Guys... As long as the table is called "Table1", it works... So I will keep it simple... Thanks so much...I wonder if there's a way to call this procedure from a Macro? I have a Macro that prompts the file and opens it...

 

[Andresleo47]

Oh nice...I'll try the function

 

[sandy666]

I wonder if there's a way to call this procedure from a Macro? I have a Macro that prompts the file and opens it...

with Power Query fortunately no

 

[lrobbo314]

Here is an optimized version of the function. Should run faster and it also deals with the parentheticals, i.e. 'Frank (huai yang) Sun.' returns 'F.S.' instead of 'F.H.Y.S'.

PQ VBA.xlsm
	A	B
1	3310672 - P7 W2 Jean Sebestien Pelletier.	J.S.P.
2	3310674 - P7 W2 Jean Sebestien Pelletier.	J.S.P.
3	3310678 - P7 W2 Natasha Trzebinski.	N.T.
4	3227881 - P1 W3 Jordan Houghton	J.H.
5	3326480 - P8 W3 Evaughn Heath	E.H.
6	3344673 - P9 W4 Katelyn Young	K.Y.
7	3264657 - P4W2 Josee Robitaille	J.R.
8	3228771 - P1 W3 Jean-Sebastien Giroux	J.G.
9	3331046 - P9 W2 Eric Diffey	E.D.
10	3331047 - P8 W4 Eric Diffey	E.D.
11	AA3181227
12	45848
13	129379
14	412978
15	117794
16	58702932
17	169217
18	67065
19	412445
20	4833
21	117794
22	2862117 - P13 W2 Matthew Saddleback	M.S.
23	2961899 - P02 W1 Hayden Matchee	H.M.
24	2878264 - P13 W3 Tyler Jacques	T.J.
25	2941274 - P01 W2 Reginald Siddall	R.S.
26	2911422 - P02 W3 Logan Gavey	L.G.
27	2914556 - P12 W4 Kaydence Wahsatnow	K.W.
28	2914549 - P12 W4 Ferleen Kakeesim	F.K.
29	2886711 - P01 W4 Cynthia Sagstven	C.S.
30	2912954 - P01 W1 Doris Laboucan	D.L.
31	2935906 - P13 W4 Jolene gray	J.G.
32	2975056 - P05 W1 Liza Jerome	L.J.
33	3012404 - P04 W4 joan McKinley	J.M.
34	3030481 - P05 W1 Valencia Del-hierro	V.D.
35	2954286 - Samantha Veltkamp	A.V.
36	2980489 - P02 W4 Mary Thomas	M.T.
37	2958912 - P01 W4 Barbara Shindeka	B.S.
38	2981640 - P04 W4 Ashton Aubichon-Corrigal	A.A.
39	3030488 - P05 W1 Valencia Del-hierro	V.D.
Sheet2

Cell Formulas
Range	Formula
B1:B39	B1	=IT(A1)

Function IT(s As String)
Dim POS As Integer: POS = InStr(s, "-")

If POS > 0 Then
    s = noParen(s)
    s = Trim(Replace(Replace(s, "  ", " "), ".", ""))
    Dim SP() As String: SP = Split(Trim(Right(s, Len(s) - POS)), " ")
    
    For i = LBound(SP) To UBound(SP)
        If Not SP(i) Like "*[0-9]" Then IT = IT & UCase(Left(SP(i), 1)) & "."
    Next i
Else
    IT = vbNullString
End If
End Function

Function noParen(s As String) As String
Dim BA() As Byte: BA = s
Dim b As Boolean: b = True

For i = LBound(BA) + 2 To UBound(BA) - 2 Step 2
    If BA(i + 2) = 40 Or BA(i - 2) = 41 Then b = Not b
    If b Then noParen = noParen & Chr(BA(i))
Next i
End Function

 

[Andresleo47]

I'm trying the Function... And there are some few records that can't be identified:

Input -> "PT-P Chq 28722405 -" ; Output -> "-.C.-."
Input -> "6911380-Bugg Sondra"; Output -> "1.S."
Input -> "88304744 - P8W2 87`Luciel Lamch"; Output -> "8.L."
Input -> "6911380-Hofer Maria"; Output -> "1.M."

I know this happened because the format is slightly different from the rest, but do you guys have any option to clear these one?

Thanks so much!

 

[lrobbo314]

This seems to take care of those edge cases.

PQ VBA.xlsm
	A	B
300	PT-P Chq 28722405 -	P.C.
301	6911380-Bugg Sondra	B.S.
302	88304744 - P8W2 87`Luciel Lamch	L.L.
303	6911380-Hofer Maria	H.M.
Sheet2

Cell Formulas
Range	Formula
B300:B303	B300	=IT(A300)

Function IT(s As String)
s = Trim(Replace(Replace(Replace(Replace(s, "  ", " "), ".", ""), " - ", "-"), "`", " "))
Dim POS As Integer: POS = InStr(s, "-")

If POS > 0 Then
    If InStr(s, "(") > 0 Then s = noParen(s)
    Dim SP() As String: SP = Split(Trim(Right(s, Len(s) - POS)), " ")
    
    For i = LBound(SP) To UBound(SP)
        If SP(i) Like "*[A-Za-z]*" And Not SP(i) Like "*[0-9]" Then IT = IT & UCase(Left(SP(i), 1)) & "."
    Next i
Else
    IT = vbNullString
End If
End Function

Function noParen(s As String) As String
Dim BA() As Byte: BA = s
Dim b As Boolean: b = True

For i = LBound(BA) + 2 To UBound(BA) - 2 Step 2
    If BA(i + 2) = 40 Or BA(i - 2) = 41 Then b = Not b
    If b Then noParen = noParen & Chr(BA(i))
Next i
End Function

 

[Peter_SSs]

Here is another macro to try. It assumes that data starts in G2 and outputs results to K2 and below.

Sub GetInitials()
  Dim RX As Object
  Dim a As Variant, b As Variant, itm As Variant
  Dim i As Long
  Dim s As String
  
  Const Pat1 As String = "(^.*\d[^A-Za-z])|(\(.*?\))"
  Const Pat2 As String = "\b[A-Z]"
  
  Set RX = CreateObject("VBScript.RegExp")
  RX.Global = True
  a = Range("G2", Range("G" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    s = UCase(a(i, 1))
    If InStr(s, "-") > 0 Then
      RX.Pattern = Pat1
      s = Replace(Replace(RX.Replace(s, ""), "-", ""), "'", "")
      RX.Pattern = Pat2
      For Each itm In RX.Execute(s)
        b(i, 1) = b(i, 1) & itm
      Next itm
    End If
  Next i
  Range("K2").Resize(UBound(b)).Value = b
End Sub

A sample of a variety of your data and the results of the above code:

Andresleo47.xlsm
	G				K
1
2	3310672 - P7 W2 Jean Sebestien Pelletier.				JSP
3	3310678 - P7 W2 Natasha Trzebinski.				NT
4	3227881 - P1 W3 Jordan Houghton				JH
5	3326480 - P8 W3 Evaughn Heath				EH
6	3344673 - P9 W4 Katelyn Young				KY
7	3264657 - P4W2 Josee Robitaille				JR
8	3228771 - P1 W3 Jean-Sebastien Giroux				JG
9	AA3181227
10	45848
11	3012404 - P04 W4 joan McKinley				JM
12	3030481 - P05 W1 Valencia Del-hierro				VD
13	2954286 - Samantha Veltkamp				SV
14	2981640 - P04 W4 Ashton Aubichon-Corrigal				AA
15	3121502 - P09 W2 Myla Sky Stanley Osuthorpe				MSSO
16	3166413 - P10 W4 Sandra NEUFELD				SN
17	3187164 - P12 W3 George etzerza				GE
18	CREDIT MEMO EQUITABLE LIFE OF CANADA
19	88316376 - P9 W3 Jackie (Jadwiga) Jakinik.				JJ
20	3521802 - P10 W3 Judit Dell'Anno.				JD
21	81745374 - P6 W1 Jasbir Kaur				JK
22	88211243 - P6 W2 Frank (huai yang) Sun.				FS
23	88218954 - P6 W1 Ashok Gangwar.				AG
24	PT-P Chq 28722405 -
25	6911380-Bugg Sondra				BS
26	88304744 - P8W2 87`Luciel Lamch				LL
27	6911380-Hofer Maria				HM
Sheet1 (2)

 

[sandy666]

maybe that's enough

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    Text = Table.TransformColumnTypes(Source,{{"Column7", type text}}),
    CEW = Table.TransformColumns(Table.AddColumn(Text, "IF", each if Text.Contains([Column7], "W") then Text.AfterDelimiter(Text.From([Column7], "en-GB"), "W") else Text.AfterDelimiter(Text.From([Column7], "en-GB"), "-")),{{"IF", Text.Proper, type text}}),
    TS = Table.AddColumn(CEW, "Initials", each Text.Select([IF],{"A".."Z"})),
    RC = Table.RemoveColumns(TS,{"IF"}),
    Date = Table.TransformColumnTypes(RC,{{"Column5", type date}, {"Column8", type date}})
in
    Date

 

[Andresleo47]

Hi Lrobbo, I tried the new function (Post # 27), and some other entries were not caught:

Input -> "Opt Rfnd -3473974-Cindy Dawson-E406923172 56530" ; Output -> "3."
Input -> "Opt Rfnd -3477855-Jodi McDonald-E000124296 335226" ; Output -> "3."
Input -> "Opt Rfnd -3487499-Avery Hansen -3031945-58 20432"; Output -> "3.H."
Input -> "Opt Rfnd -81740059-Samantha Davidson -630787490 1"; Output -> "8.D"
Input -> "Opt Rfnd -88305627-Emmanuel Airwele-643826201 1001"; Output -> "8."

I'll try Sandy's solution and Peter's solution. Thanks for all your input!!

Andres