Ignore "-"

  • Thread starter Thread starter msnyc07
  • Start date Start date
M

msnyc07

I have a script that generates acronyms from company names. It was set it up
to ignore of, and, the, etc. (I didn't code it just spec'd it)

If Not (UCase(prom) = "OF") And Not (UCase(prom) = "FOR") And Not
(UCase(prom) = "THE") And _
Not (UCase(prom) = "AND") And Not (UCase(prom) = "A") And
Not (UCase(prom) = "ON") And Not (prom) = "-" Then

The problem is I need it to also ignore hyphens so for instance

Society for Maternal-Fetal Medicine

becomes

SMFM

I tried adding a hyphen to the code above (w/o UCASE) but it doesn't work.

Anyway I can do this without having to remove the hyphens themselves?
 
Paste the below code and try running MyMacro or use that as a UDF

With the name in cell A1..try the below formula
=GetAcronym(A1)

Sub MyMacro()
MsgBox GetAcronym("Society for Maternal-Fetal Medicine")
End Sub

Function GetAcronym(strName As String) As String
Dim arrName As Variant
strName = " " & strName & " "
strName = Replace(strName, " of ", " ", , , vbTextCompare)
strName = Replace(strName, " for ", " ", , , vbTextCompare)
strName = Replace(strName, " the ", " ", , , vbTextCompare)
strName = Replace(strName, " and ", " ", , , vbTextCompare)
strName = Replace(strName, " a ", " ", , , vbTextCompare)
strName = Replace(strName, " on ", " ", , , vbTextCompare)
strName = Replace(strName, "-", " ", , , vbTextCompare)
arrName = Split(strName)
For intCount = 0 To UBound(arrName)
GetAcronym = GetAcronym & Left(arrName(intCount), 1)
Next
End Function
 
A few lines shorter...

Function GetAcronym(ByVal S As String) As String
Dim X As Long, Words() As String
Const NonWords As String = "*OF*FOR*THE*AND*A*ON*"
Words = Split(Replace(S, "-", " "))
For X = 0 To UBound(Words)
If InStr(1, NonWords, "*" & Words(X) & "*", vbTextCompare) = 0 Then
GetAcronym = GetAcronym & Left(Words(X), 1)
End If
Next
End Function
 
Thanks both of you. Since I need to incorporate this into a much larger
multi-function function which I can't modify much as it passes variables all
over the place and I am not a coder (just fixing a coder's work who is AWOL)
is it possible for me to just incorporate the key parts of this into an
existing function? I am assuming it is the Split command but not sure, here
is the code I am working with, any help appreciated. I've managed to fix
everything else this is the last step:

Private Function GenerateAcronym(ByVal val As String) As String 'Tested OK
Dim str As String, prom As String, ch As String, res As String
Dim pos As Long

res = ""
str = Trim(val)

If Len(str) > 0 Then
While InStr(str, " ") > 1
prom = Trim(Left(str, InStr(str, " ") - 1))

If Not (UCase(prom) = "OF") And Not (UCase(prom) = "FOR") And Not
(UCase(prom) = "THE") And _
Not (UCase(prom) = "AND") And Not (UCase(prom) = "A") And Not
(UCase(prom) = "ON") And Not (prom) = "-" Then

ch = Left(prom, 1)
If (Asc(ch) >= 65 And Asc(ch) <= 90) Or (Asc(ch) >= 97 And
Asc(ch) <= 122) Then
res = res + Left(prom, 1)
End If
End If

'str = Trim(Right(str, Len(str) - InStr(str, " ")))
res = res + Left(str, 1)
'Wend



prom = str
If Not (UCase(prom) = "OF") And Not (UCase(prom) = "FOR") And Not
(UCase(prom) = "THE") And _
Not (UCase(prom) = "AND") And Not (UCase(prom) = "A") And Not
(UCase(prom) = "ON") Then

ch = Left(prom, 1)
If (Asc(ch) >= 65 And Asc(ch) <= 90) Or (Asc(ch) >= 97 And
Asc(ch) <= 122) Then
res = res + Left(prom, 1)
End If


End If
End If

If Len(res) = 1 Then
GenerateAcronym = str

Else
GenerateAcronym = UCase(res)

End If


End Function
 
I'm a little confused by your posting. Are you saying you don't have a stand
alone function named GenerateAcronym (or some other similar function name)
and that you want to integrate what Jacob or I posted directly into the code
of some much larger subroutine or function? If so, then there is no way we
can answer that question without seeing the code you want to integrate it
into. However, if you do have a separate GenerateAcronym function in your
project, you would need to show us that so we can try and access if it is
making use of any global variables (this will undoubtedly require some more
back and forth from between us as we try an ascertain what variable are
local to the function and which are not). If you do have a stand alone
GenerateAcronym function, and IF IT WERE CODED CORRECTLY, then you would be
able to simply replace what you have with either of the functions Jacob or I
posted; but without knowing more about the rest of your code, it would be
kind of hard to advise you with any sense of certainty.
 
I'm not much for code, but couldn't you just do this:

=GenerateAcronym(SUBSTITUTE(A1,"-"," "))
 
Wow it ended up being even easier. #1 VBA didn't like Substitute so I found
Replace. But in the line after it defined the string to be processed I just
added:

str = Replace(str, "-", " ")

Thanks everyone!
 
Back
Top