If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below. |
|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Ignore "-"
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? |
#2
|
|||
|
|||
Ignore "-"
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 -- Jacob "msnyc07" wrote: 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? |
#3
|
|||
|
|||
Ignore "-"
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 -- Rick (MVP - Excel) "Jacob Skaria" wrote in message ... 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 -- Jacob "msnyc07" wrote: 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? |
#4
|
|||
|
|||
Ignore "-"
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 "Rick Rothstein" wrote: 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 -- Rick (MVP - Excel) "Jacob Skaria" wrote in message ... 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 -- Jacob "msnyc07" wrote: 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? . |
#5
|
|||
|
|||
Ignore "-"
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. -- Rick (MVP - Excel) "msnyc07" wrote in message ... 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 "Rick Rothstein" wrote: 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 -- Rick (MVP - Excel) "Jacob Skaria" wrote in message ... 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 -- Jacob "msnyc07" wrote: 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? . |
#6
|
|||
|
|||
Ignore "-"
I'm not much for code, but couldn't you just do this:
=GenerateAcronym(SUBSTITUTE(A1,"-"," ")) msnyc07 wrote: 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 "Rick Rothstein" wrote: 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 -- Rick (MVP - Excel) "Jacob Skaria" wrote in message ... 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 -- Jacob "msnyc07" wrote: 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? . |
#7
|
|||
|
|||
Ignore "-"
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! "Glenn" wrote: I'm not much for code, but couldn't you just do this: =GenerateAcronym(SUBSTITUTE(A1,"-"," ")) msnyc07 wrote: 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 "Rick Rothstein" wrote: 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 -- Rick (MVP - Excel) "Jacob Skaria" wrote in message ... 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 -- Jacob "msnyc07" wrote: 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? . . |
Thread Tools | |
Display Modes | |
|
|