Solved Calculating initials

[Kayleigh]

Hi,
I have two fields first and last name - both may contain more than one word. I would like to calculate initials in a query.
Can I create a function to do this. Saw a post about this but not completely sure how to apply this.
Any suggestions?

 

[pbaldy]

If that code does what you want, I'd make it a public function that takes the name fields as inputs and returns the desired string. You can call it from the query.

 

[Kayleigh]

Well its not completely correct as it has hard-coded in the words to change to initials. So how do I adjust to include the fields I would like?

 

[pbaldy]

Dirk's code could be modified to look at an input string:

Split(strInput, " ")

Where your function looked like:

Public Function GetInitials(strInput As String) As String

and you called it like

GetInitials(FirstName & " " & LastName)

using your actual field names of course.

 

[arnelgp]

Public Function GetInitials(ByVal pString As Variant) As String
Dim var As Variant
Dim v As Variant
Dim sValue As String
If IsNull(pString) Then Exit Function
var = Split(pString, " ")
For Each v In var
    If Len(Trim$(v)) > 0 Then
        sValue = sValue & UCase(Left$(v, 1))
    End If
Next
GetInitials = sValue
End Function

example:
dim sInitials As String
sInitials = GetInitials("arnel gasparin puzon")
Debug.Print sInitials

Result:
AGP

 

[Kayleigh]

That worked fab!
My next question is how to adapt this function further or write similar code so I can take a text string like "Mrs Jones" or "Jack Robinson" and output "Jones, Mrs" and "Robinson, Jack"?

 

[pbaldy]

Which function? Since both use the Split() function, concatenate the second value with a comma and the first value. Plus decide what to do when there are more/less than 2 values.

 

[Kayleigh]

Referring to @arnelgp 's function above. I understand the concatenate but how do I pull out the very last word of a string?
If <2 words do nothing.

 

[pbaldy]

Check out UBound(); it will give you the zero-based value of the array count.

 

[pbaldy]

What does picking out the last word have to do with getting the initials?

We've moved on Pat.

 

[MajP]

Your example begs a question. You will always have 1 or 2 words.
Mrs. Robinson or Jack Robinson
So no Mrs Mary Robinson or Ms Mary Beth Robinson Or Mr. Jack Robinson?

 

[pbaldy]

Plus decide what to do when there are more/less than 2 values.

 

[Kayleigh]

So obviously there can be many combinations. But I am targetting at strings usually with two/three words so function should find last word and put at beginning of string then a comma and other words in string is put after it. I am not concerned about title of name - surname is most important. (If less than 2 values function not necessary.)

 

[gemma-the-husky]

does this work for you. It capitalizes each word. VBA Upper, Lower, and Proper Case - Case Functions - Automate Excel
This was an Excel example, but it works in Access.

You need a space between initials, though.

ab smith --> Ab Smith
a b smith -->A B Smith

It's always tricky though. Mcdonald won't become McDonald. And McDonald will become Mcdonald. The vagaries of English, or indeed any language.

 

[Kayleigh]

Are you assuming words are capitalized because not sure that that is the case...

 

[gemma-the-husky]

Sorry, I thought you were trying to find an easy way to capitalise the first letter of each word.

 

[pbaldy]

So obviously there can be many combinations. But I am targetting at strings usually with two/three words so function should find last word and put at beginning of string then a comma and other words in string is put after it. I am not concerned about title of name - surname is most important. (If less than 2 values function not necessary.)

Did you look at UBound() with the Split() function?

 

[Kayleigh]

Have messed about with code mentioned above and this is my result - but doesn't do exactly what I want. Can anyone tidy it up pls?
(Just as reminder - would like "Mr Peter Jones" to become "Jones, Mr Peter")

Public Function reorderText(ByVal textString As Variant) As String
Dim var As Variant
Dim firstVal As String
Dim lastVal As String

If (IsNull(textString)) Or (Len(textString) < 2) Then Exit Function
var = Split(textString, " ")
firstVal = UBound(var, 1)
lastVal = LBound(var, 1)
reorderText = Trim(lastVal) & ", " & Trim(firstVal)
End Function

Ps. Haven't spent much time perfecting as it is only required to make all fields consistent and for sorting purposes.

 

[MajP]

Public Function reorderText(ByVal textString As Variant) As String
  Dim var As Variant
  Dim firstVal As String
  Dim lastVal As String
  Dim aVals() As String
  Dim I As Integer
  If Not IsNull(textString) Then
    aVals = Split(textString, " ")
    reorderText = aVals(UBound(aVals)) & ", "
    For I = 0 To UBound(aVals) - 1
      reorderText = reorderText & aVals(I) & " "
    Next I
    reorderText = Trim(reorderText)
 End If

End Function

Public Sub test()
  Debug.Print reorderText(Null)
  Debug.Print reorderText("Madonna")
  Debug.Print reorderText("Mr Jones")
  Debug.Print reorderText("Mr. John Smith")
  Debug.Print reorderText("John Michael Smith")
End Sub

Madonna,
Jones, Mr
Smith, Mr. John
Smith, John Michael

 

[arnelgp]

Public Function reorderText(ByVal textString As Variant) As String
Dim var As Variant, i As Integer
textString = textString & vbNullString
reorderText = textString
If Len(textString) < 1 Then Exit Function
Do Until InStr(1, textString, "  ") = 0
    textString = Replace$(textString, "  ", " ")
Loop
var = Split(textString, " ")
Select Case UBound(var)
Case Is > 1
    If HaveJr(var(UBound(var))) Then
        textString = var(UBound(var) - 1) & " " & var(UBound(var)) & ", "
        For i = 0 To UBound(var) - 2
            textString = textString & var(i) & " "
        Next
    Else
        textString = var(UBound(var)) & ", "
        For i = 0 To UBound(var) - 1
            textString = textString & var(i) & " "
        Next
    End If
    textString = Trim$(textString)
Case Is = 1
    textString = var(1) & ", " & var(0)
End Select
reorderText = textString
End Function

Public Function HaveJr(ByVal p As String) As Boolean
Const t As String = "/jr/sr/i/ii/iii/iv/v/vi/vii/viii/ix/x/xi/xii/xii/xiv/xv/"
If Len(p) < 1 Then Exit Function
p = Replace$(p, ".", "")
HaveJr = t Like "*/" & p & "/*"
End Function