Create Acronym (Extract first letter of each word)

[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.

[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

[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

--
Chees,
Shane Devenshire

[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

--
Cheers,
Shane Devenshire

[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.

--
Cheers,
Shane Devenshire

[CLR]

Cool Shane, and it works well in XL97 too............

Vaya con Dios,
Chuck, CABGx3

[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.

[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(

[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.

[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

> > > Thanks.- Hide quoted text -
>
> - Show quoted text -

[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.

[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

> > > - Show quoted text -- Hide quoted text -

[Ron Rosenfeld]

On Wed, 16 Jan 2008 09:56:04 -0800, VB_Sam <VB...@discussions.microsoft.com>
wrote:

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

[Ron Rosenfeld]

On Sat, 19 Jan 2008 16:00:33 -0500, Ron Rosenfeld <ronros...@nospam.org>
wrote:

>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

[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.

> On Wednesday, January 16, 2008 12:56 PM VBSa wrote:

> 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:

>>>>>> On Wednesday, January 16, 2008 2:09 PM CL wrote:

>>>>>> Cool Shane, and it works well in XL97 too............
>>>>>>
>>>>>> 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:

>>>>>>>>>> On Thursday, January 17, 2008 6:53 AM Pete_UK wrote:

>>>>>>>>>> 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 =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 <VB_...@discussions.microsoft.com> 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 <VB...@discussions.microsoft.com> wrote:
>>>>>>>>>>>> ll
>>>>>>>>>>>> 1, 1)
>>>>>>>>>>>> remove

>>>>>>>>>>>> Submitted via EggHeadCafe - Software Developer Portal of Choice
>>>>>>>>>>>> Styling the WPF ScrollViewer
>>>>>>>>>>>> http://www.eggheadcafe.com/tutorials/aspnet/f51ddf8c-5227-4f1b-a5df-ec3d1b3439ca/styling-the-wpf-scrollviewer.aspx

[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" <coli...@maxnet.co.nz> wrote in message
news:201010202...@eggheadcafe.com...

[juan2m...@gmail.com]

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

[articula...@gmail.com]

Hi, Is there a way to create acronyms in Google Sheets?

[Benoît]

This is the easy way: One word per cell and use the left() function.

Example :
A B C D
1 I am a boy

I have a French version of Excel
=MAJUSCULE(GAUCHE(A1;1)&GAUCHE(B1;1)&GAUCHE(C1;1)&GAUCHE(D1;1))

I suppose that in English it should be sommething like
=CAPITAL(LEFT(A1;1)&LEFT(B1;1)&LEFT(C1;1)&LEFT(D1;1))

And it should work in any spreadsheet software.



--
Vie : n.f. maladie mortelle sexuellement transmissible
Benoit chez lui à leraillez.com

[ben....@outbeyond.com.au]

Hi Shane, long time since you posted this I can see, but I'm wondered where do you put this? I tried putting it into the script editor but it has a problem with the first line. I would like to create an acronym of a word and this seems to be the best response I've found but I'm unable how to use it!

Thanks

[GS]

The following function does what you want. Just copy/paste the code into a
standard module in VBE under the workbook you want to use it.

Option Explicit

Function MakeAcronym$(sWordsIn$)
' Returns a string of 1st character of each word in sWordsIn
' converted to uppercase
Dim vWord, s1$
For Each vWord In Split(sWordsIn, " ")
s1 = s1 & Mid(vWord, 1, 1)
Next 'vWord
MakeAcronym = UCase$(s1)
End Function

To use it in a worksheet formula in that workbook where words are in colA, in
the col where you want the acronym type the following formula:

=MakeAcronym(A1) (Revise the cell ref to suit the row#)

You can also use the function in VBA as follows, for example:

Sub Doit_1()
' Puts the acronym into a string variable to be used in VBA
Dim s1$
s1 = MakeAcronym(ActiveCell.Value)
'do something with s1
Debug.Print s1
End Sub

Sub Doit_2()
' Inserts the acronym in the next col
ActiveCell.Offset(0, 1) = MakeAcronym(ActiveCell.Value)
End Sub

Sub Doit_3()
' Inserts acronym in next col of selected cells
' (cells do not need to be contiguous)
Dim vRng
For Each vRng In Selection.Cells
vRng.Offset(0, 1) = MakeAcronym(vRng.Value)
Next 'vRng
End Sub

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

[moneym...@gmail.com]

=left(cell no,no of letter u want to extract)