Create Acronym (Extract first letter of each word)


V

VB_Sam

How can I extract first letter of each word in Excel XP?

For example:
I am a boy
You are a girl

Using the pseudo-function called acronym(), the result will become:
IAAB
YAAG

I'm using Excel XP.
Is there any function which can do it?
If not, could anyone provide a macro for me?
(I'm only a beginner in macro)

Thanks.
 
Ad

Advertisements

C

CLR

The long way around would be to do Data > TextToColumns > space
delimited....to separate each word into it's own column...........then to
CONCATENATE the
=LEFT(CELL,1) of each of those cells.....

Vaya con Dios,
Chuck, CABGx3
 
S

ShaneDevenshire

The following macro will place the result in the cell to the right of the
cell you are testing.

Sub Shorten()
Dim T As Range, I As Integer, myWord As String
E = ActiveCell
myWord = Left(E, 1)
For I = 2 To Len(ActiveCell.Value)
If Mid(E, I, 1) = " " Then
myWord = myWord & Mid(E, I + 1, 1)
End If
Next I
ActiveCell.Offset(0, 1) = myWord
End Sub
 
S

ShaneDevenshire

Hi,

The following modification of my previous macro will allow you to select a
column of item and it will put the results in the column to the right for all
the selected cells.

Sub Shorten()
Dim T As Range, I As Integer, myWord As String
For Each cell In Selection
E = cell
myWord = Left(E, 1)
For I = 2 To Len(cell)
If Mid(E, I, 1) = " " Then
myWord = myWord & Mid(E, I + 1, 1)
End If
Next I
cell.Offset(0, 1) = myWord
Next cell
End Sub
 
S

ShaneDevenshire

Hi again,

If you want a spreadsheet function to do this:

Function Ext(myText As String) As String
Dim I As Integer, myWord As String
myWord = Left(myText, 1)
For I = 2 To Len(myText)
If Mid(myText, I, 1) = " " Then
myWord = myWord & Mid(myText, I + 1, 1)
End If
Next I
Ext = myWord
End Function

then in any cell type =Ext(A1)

where A1 contains the text you want to operate on.

Note: in my previous macro I dimmed T but I didn't use it, you could remove
it from the Dim statement line if you wish.
 
Ad

Advertisements

V

VB_Sam

Thanks for the macro.
Is it possible to create a UDF (custom function) instead so I can use it
anywhere and can do dynamic update?

A1: I am a boy
B1: Acronym(A1)
B1 answer is IAAB

If I change the cell in A1, the function will auto-update itself.
Thanks a lot.
 
V

VB_Sam

Bug

For example:
Phantom Client (Reserved)

I expect:
PCR
or
PC(R)

[Note: I prefer the latter although both are ok]

However it turns out to be:
PC(
 
V

VB_Sam

Thanks. It works. But there is one problem.

For example:
Phantom-Client Ocean/Sea (Reserved!)

Expected result:
PCOSR or PCO/S(R)

Actual result:
PO(

Is it possible to have a fix?

Perhaps add a code to remove all punctuation/symbols before it proceed:

Pseudo-code:
Read "Phantom-Client Ocean/Sea (Reserved!)"
Replace "-" or "/" with a space. Output: "Phantom Client Ocean Sea
(Reserved!)"
Remove any symbol found. Output: "Phantom Client Ocean Sea Reserved"
Extract the first letter of each word. Output: "PCOSR"

Thanks a lot.
 
P

Pete_UK

This will give you just characters in your acronym:

Function Acronym(phrase As String) As String
Dim i As Integer
Dim ch As String, words As String
Acronym = ""
phrase = Trim(phrase)
If Len(phrase) < 1 Then End
words = ""
For i = 1 To Len(phrase)
ch = UCase(Mid(phrase, i, 1))
If ch = "-" Or ch = "/" Then ch = " "
If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
words = words & ch
End If
Next i
If (Len(words) < 1) Then End
Acronym = Left(words, 1)
For i = 2 To Len(words)
ch = Mid(words, i, 1)
If ch = " " Then
Acronym = Acronym & Mid(words, i + 1, 1)
End If
Next i
End Function

Put your phrase in A1, and use it as:

=Acronym(A1)

It produces PCOSR from Phantom-Client Ocean/Sea (Reserved!), as it
treats a hyphen and forward slash as if they were a space. The acronym
will always be upper case.

Hope this helps.

Pete
 
V

VB_Sam

Thanks.

There are some minor bugs.
John / Mary
Phrases with more than one space, eg:
Litter___Go___Ride

_ is a space in this case.

Expected:
JM
LGR

It turns out to be:
J M
L__G__R


One code should be added to remove all space after you finish extracting all
first letters.
 
Ad

Advertisements

P

Pete_UK

The Trim function was meant to stop that happening, but it works
differently than in a worksheet. This version clears up the multi-
space errors:

Function Acronym(phrase As String) As String
Dim i As Integer
Dim ch As String, words As String
Acronym = ""
phrase = Trim(phrase)
If Len(phrase) < 1 Then End
words = ""
For i = 1 To Len(phrase)
ch = UCase(Mid(phrase, i, 1))
If ch = "-" Or ch = "/" Then ch = " "
If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
words = words & ch
End If
Next i
If (Len(words) < 1) Then End
Acronym = Left(words, 1)
For i = 2 To Len(words)
ch = Mid(words, i, 1)
If ch = " " Then
Acronym = Acronym & Mid(words, i + 1, 1)
End If
Next i
words = Acronym
If Len(Acronym) > 1 Then
Acronym = Left(words, 1)
For i = 2 To Len(words)
ch = Mid(words, i, 1)
If ch = " " Then ch = ""
Acronym = Acronym & ch
Next i
End If
End Function

But, keep testing it...

Pete
 
R

Ron Rosenfeld

How can I extract first letter of each word in Excel XP?

For example:
I am a boy
You are a girl

Using the pseudo-function called acronym(), the result will become:
IAAB
YAAG

I'm using Excel XP.
Is there any function which can do it?
If not, could anyone provide a macro for me?
(I'm only a beginner in macro)

Thanks.

It would be best if you could give all your requirements at once.

For example, for the problem you pose above, with your examples showing only
space-delimited words, there is a very simple VBA solution:

==============================
Function Split1(str As String) As String
Dim sTemp() As String
Dim i As Long
sTemp = Split(Application.WorksheetFunction.Trim(str))
For i = 0 To UBound(sTemp)
Split1 = Split1 & UCase(Left(sTemp(i), 1))
Next i
End Function
====================================

But then you add a parameter that the first letter of a word might be enclosed
in parentheses:

----------------------
Phantom Client (Reserved)

I expect:
PCR
or
PC(R)
-----------------------------

Then, in another message, you add a requirement that some character in addition
to a space might be between the two words:

---------------------------------
John / Mary
Phrases with more than one space, eg:
Litter___Go___Ride
----------------------------

The following UDF will take care of all the examples you've given, but if you
have more and different requirements, please try to post them all at once:

=============================================
Function Acronym(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "(\w).*?(\W+|\s+|$)"
Acronym = UCase(re.Replace(str, "$1"))
End Function
============================================

But even this might not handle the following in the manner in which you expect:

John/Mary --> JM
John_Mary --> J

This can be easily changed, but you need to be more specific as to what you
really want. Rather than just giving examples, you need to devise rules that
will work for all cases.
--ron
 
R

Ron Rosenfeld

The following UDF will take care of all the examples you've given, but if you
have more and different requirements, please try to post them all at once:

=============================================
Function Acronym(str As String) As String
Dim re As Object
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "(\w).*?(\W+|\s+|$)"
Acronym = UCase(re.Replace(str, "$1"))
End Function
============================================

But even this might not handle the following in the manner in which you expect:

John/Mary --> JM
John_Mary --> J

This can be easily changed, but you need to be more specific as to what you
really want. Rather than just giving examples, you need to devise rules that
will work for all cases.

Note that changing one line will ensure that a <space> is required between
words, but will ignore other potential word separators, and also insist that
the first character be a letter or digit:

=======================
re.Pattern = "([A-Z0-9]).*?(\s+[\W_]*|([\W_]*\s+)[\W_]?|$)"
=======================
--ron
 
J

Jeremy Pyle

What micro do I use if I want to duplicate a letter in a word. For example if I had the word computer in a cell, what macro would I use the duplicate the 3rd letter of the word which is "m". Therefore in the 2nd cell, it would show commputer

What macro would I use to reverse the order of letters. For example, if computer is in the first cell, how do I make it reverse the 3rd and letters of the word. So computer in the 1st cell would before copmuter in the second cell.
How can I extract first letter of each word in Excel XP?

For example:
I am a boy
You are a girl

Using the pseudo-function called acronym(), the result will become:
IAAB
YAAG

I'm using Excel XP.
Is there any function which can do it?
If not, could anyone provide a macro for me?
(I'm only a beginner in macro)

Thanks.
On Wednesday, January 16, 2008 1:14 PM CL wrote:
The long way around would be to do Data > TextToColumns > space
delimited....to separate each word into it's own column...........then to
CONCATENATE the
=LEFT(CELL,1) of each of those cells.....

Vaya con Dios,
Chuck, CABGx3



"VB_Sam" wrote:
On Wednesday, January 16, 2008 2:23 PM VBSa wrote:
Bug

For example:
Phantom Client (Reserved)

I expect:
PCR
or
PC(R)

[Note: I prefer the latter although both are ok]

However it turns out to be:
PC(



"ShaneDevenshire" wrote:
 
R

Rick Rothstein

You didn't say where the 2nd cell is (below or next to), so I guessed next
to). These two macros should do what you asked...

Sub DuplicateLetter()
Dim Text As String, Position As Long
Position = 3
Text = ActiveCell.Value
ActiveCell.Offset(, 1).Value = Replace(Text, Mid(Text, Position, 1), _
String(2, Mid(Text, Position, 1)), , 1)
End Sub

Sub SwapAdjacentLetters()
Dim Text As String, Position As Long
Position = 3
Text = ActiveCell.Value
Mid(Text, Position, 2) = StrReverse(Mid(Text, Position, 2))
ActiveCell.Offset(, 1).Value = Text
End Sub

Note, however, that you can do this with formulas...

Duplicate Letter: =REPLACE(A1,3,1,MID(A1,3,1)&MID(A1,3,1))
Swap Letters: =REPLACE(A1,3,2,MID(A1,4,1)&MID(A1,3,1))

--
Rick Rothstein (MVP - Excel)


Jeremy Pyle said:
What micro do I use if I want to duplicate a letter in a word. For example
if I had the word computer in a cell, what macro would I use the duplicate
the 3rd letter of the word which is "m". Therefore in the 2nd cell, it
would show commputer

What macro would I use to reverse the order of letters. For example, if
computer is in the first cell, how do I make it reverse the 3rd and
letters of the word. So computer in the 1st cell would before copmuter in
the second cell.
How can I extract first letter of each word in Excel XP?

For example:
I am a boy
You are a girl

Using the pseudo-function called acronym(), the result will become:
IAAB
YAAG

I'm using Excel XP.
Is there any function which can do it?
If not, could anyone provide a macro for me?
(I'm only a beginner in macro)

Thanks.
On Wednesday, January 16, 2008 1:14 PM CL wrote:
The long way around would be to do Data > TextToColumns > space
delimited....to separate each word into it's own column...........then
to
CONCATENATE the
=LEFT(CELL,1) of each of those cells.....

Vaya con Dios,
Chuck, CABGx3



"VB_Sam" wrote:
On Wednesday, January 16, 2008 1:44 PM ShaneDevenshir wrote:
The following macro will place the result in the cell to the right of
the
cell you are testing.

Sub Shorten()
Dim T As Range, I As Integer, myWord As String
E = ActiveCell
myWord = Left(E, 1)
For I = 2 To Len(ActiveCell.Value)
If Mid(E, I, 1) = " " Then
myWord = myWord & Mid(E, I + 1, 1)
End If
Next I
ActiveCell.Offset(0, 1) = myWord
End Sub

--
Chees,
Shane Devenshire


"VB_Sam" wrote:
On Wednesday, January 16, 2008 1:48 PM ShaneDevenshir wrote:
Hi,

The following modification of my previous macro will allow you to
select a
column of item and it will put the results in the column to the right
for all
the selected cells.

Sub Shorten()
Dim T As Range, I As Integer, myWord As String
For Each cell In Selection
E = cell
myWord = Left(E, 1)
For I = 2 To Len(cell)
If Mid(E, I, 1) = " " Then
myWord = myWord & Mid(E, I + 1, 1)
End If
Next I
cell.Offset(0, 1) = myWord
Next cell
End Sub

--
Cheers,
Shane Devenshire


"VB_Sam" wrote:
On Wednesday, January 16, 2008 1:55 PM ShaneDevenshir wrote:
Hi again,

If you want a spreadsheet function to do this:

Function Ext(myText As String) As String
Dim I As Integer, myWord As String
myWord = Left(myText, 1)
For I = 2 To Len(myText)
If Mid(myText, I, 1) = " " Then
myWord = myWord & Mid(myText, I + 1, 1)
End If
Next I
Ext = myWord
End Function

then in any cell type =Ext(A1)

where A1 contains the text you want to operate on.

Note: in my previous macro I dimmed T but I didn't use it, you could
remove
it from the Dim statement line if you wish.

--
Cheers,
Shane Devenshire


"VB_Sam" wrote:
.........

Vaya con Dios,
Chuck, CABGx3



"ShaneDevenshire" wrote:
On Wednesday, January 16, 2008 2:15 PM VBSa wrote:
Thanks for the macro.
Is it possible to create a UDF (custom function) instead so I can
use it
anywhere and can do dynamic update?

A1: I am a boy
B1: Acronym(A1)
B1 answer is IAAB

If I change the cell in A1, the function will auto-update itself.
Thanks a lot.


"ShaneDevenshire" wrote:
On Wednesday, January 16, 2008 2:23 PM VBSa wrote:
Bug

For example:
Phantom Client (Reserved)

I expect:
PCR
or
PC(R)

[Note: I prefer the latter although both are ok]

However it turns out to be:
PC(



"ShaneDevenshire" wrote:
On Wednesday, January 16, 2008 10:44 PM VB_Sa wrote:
Thanks. It works. But there is one problem.

For example:
Phantom-Client Ocean/Sea (Reserved!)

Expected result:
PCOSR or PCO/S(R)

Actual result:
PO(

Is it possible to have a fix?

Perhaps add a code to remove all punctuation/symbols before it
proceed:

Pseudo-code:
Read "Phantom-Client Ocean/Sea (Reserved!)"
Replace "-" or "/" with a space. Output: "Phantom Client Ocean
Sea
(Reserved!)"
Remove any symbol found. Output: "Phantom Client Ocean Sea
Reserved"
Extract the first letter of each word. Output: "PCOSR"

Thanks a lot.


"ShaneDevenshire" wrote:
Function Acronym(phrase As String) As String
Dim i As Integer
Dim ch As String, words As String
Acronym =3D ""
phrase =3D Trim(phrase)
If Len(phrase) < 1 Then End
words =3D ""
For i =3D 1 To Len(phrase)
ch =3D UCase(Mid(phrase, i, 1))
If ch =3D "-" Or ch =3D "/" Then ch =3D " "
If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
words =3D words & ch
End If
Next i
If (Len(words) < 1) Then End
Acronym =3D Left(words, 1)
For i =3D 2 To Len(words)
ch =3D Mid(words, i, 1)
If ch =3D " " Then
Acronym =3D Acronym & Mid(words, i + 1, 1)
End If
Next i
End Function

Put your phrase in A1, and use it as:

=3DAcronym(A1)

It produces PCOSR from Phantom-Client Ocean/Sea (Reserved!), as
it
treats a hyphen and forward slash as if they were a space. The
acronym
will always be upper case.

Hope this helps.

Pete

On Jan 17, 3:44=A0am, VB_Sam <[email protected]>
wrote:
)
ove
On Thursday, January 17, 2008 1:23 PM VBSa wrote:
Thanks.

There are some minor bugs.
John / Mary
Phrases with more than one space, eg:
Litter___Go___Ride

_ is a space in this case.

Expected:
JM
LGR

It turns out to be:
J M
L__G__R


One code should be added to remove all space after you finish
extracting all
first letters.



"Pete_UK" wrote:
On Saturday, January 19, 2008 3:24 PM Pete_UK wrote:
The Trim function was meant to stop that happening, but it
works
differently than in a worksheet. This version clears up the
multi-
space errors:

Function Acronym(phrase As String) As String
Dim i As Integer
Dim ch As String, words As String
Acronym =3D ""
phrase =3D Trim(phrase)
If Len(phrase) < 1 Then End
words =3D ""
For i =3D 1 To Len(phrase)
ch =3D UCase(Mid(phrase, i, 1))
If ch =3D "-" Or ch =3D "/" Then ch =3D " "
If InStr(" ABCDEFGHIJKLMNOPQRSTUVWXYZ", ch) > 0 Then
words =3D words & ch
End If
Next i
If (Len(words) < 1) Then End
Acronym =3D Left(words, 1)
For i =3D 2 To Len(words)
ch =3D Mid(words, i, 1)
If ch =3D " " Then
Acronym =3D Acronym & Mid(words, i + 1, 1)
End If
Next i
words =3D Acronym
If Len(Acronym) > 1 Then
Acronym =3D Left(words, 1)
For i =3D 2 To Len(words)
ch =3D Mid(words, i, 1)
If ch =3D " " Then ch =3D ""
Acronym =3D Acronym & ch
Next i
End If
End Function

But, keep testing it...

Pete

On Jan 17, 6:23=A0pm, VB_Sam <[email protected]>
wrote:
ll
1, 1)
remove
Submitted via EggHeadCafe - Software Developer Portal of
Choice
Styling the WPF ScrollViewer
http://www.eggheadcafe.com/tutorial...c3d1b3439ca/styling-the-wpf-scrollviewer.aspx
 
Ad

Advertisements

J

juan2machado

Hello.

I'm really thankful I found your solution.

I'd like to know the best practice to make it ignore middle letters for example: Bureau of Investigation, originally it would build BOI. I'd like to ignore the word "of" and have only "BI".

Thank you very much.

Juan
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top