Check for # of Words in Function

M

msnyc07

Apologies in advance, I am NOT a coder, I am trying to fix VBA someone wrote
for me by 'slogging' through it on my own. Making some decent headway on
easier stuff but I am at an impasse.

He has a function that creates an Acronym out of a Value. However I want to
modify it so it ONLY does it if the # of words in that value > 1. Can anyone
give me a heads up on how to add that here please? It would be most
appreciated:

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") 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") 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

GenerateAcronym = UCase(res)

End Function
 
D

Dave Peterson

First, this needs xl2k or higher since it uses VBA's Split command. But if you
need to support xl97 and before, there's some code you can add that will make it
work.

Second, sometimes making the string uppercase to start will make the code easier
to write/update. You won't have to check for each comparison.

Third, instead of having lots of comparisons in an If/and/or, using Select Case
can be easier to write/update.

Option Explicit
Private Function GenerateAcronym2(ByVal val As String) As String
Dim myStr As String
Dim wCtr As Long
Dim mySplit As Variant
Dim myAcronym As String
Dim LeadChar As String

'remove all the extra spaces and make it upper case
myStr = UCase(Application.Trim(val))

If Len(myStr) = 0 Then
myAcronym = ""
Else
mySplit = Split(myStr, " ")
If UBound(mySplit) - LBound(mySplit) = 0 Then
'only one word
myAcronym = val 'whatever was passed or myStr????
Else
myAcronym = ""
For wCtr = LBound(mySplit) To UBound(mySplit)
Select Case mySplit(wCtr)
Case Is = "OF", "FOR", "THE", "AND", "A"
'skip it
Case Else
'Check to make sure it's A to Z
LeadChar = Left(mySplit(wCtr), 1)
If Asc(LeadChar) >= Asc("A") _
And Asc(LeadChar) <= Asc("Z") Then
myAcronym = myAcronym & LeadChar
End If
End Select
Next wCtr
End If
End If

GenerateAcronym2 = myAcronym

End Function
 
M

msnyc07

Thanks. I'll take a look at that, as I said code is 'not my bag man' but
thanks for the insight.

I did an easy fix at the end instead

If Len(res) = 1 Then
GenerateAcronym = str
Else
GenerateAcronym = UCase(res)
End If

i.e. I just let it process and if the final Acronym Length was 1 just use
the original string instead.
 
R

Ron Rosenfeld

Apologies in advance, I am NOT a coder, I am trying to fix VBA someone wrote
for me by 'slogging' through it on my own. Making some decent headway on
easier stuff but I am at an impasse.

He has a function that creates an Acronym out of a Value. However I want to
modify it so it ONLY does it if the # of words in that value > 1. Can anyone
give me a heads up on how to add that here please? It would be most
appreciated:

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") 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") 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

GenerateAcronym = UCase(res)

End Function
Click to expand...

Here's a bit shorter function using Regular Expressions that should accomplish
the same thing.

If I understand the rules correctly, the Acronym is formed by returning the
capitalized first letter of every word that starts with a letter (A-Za-z),
unless that word is OF, FOR, AND, A, THE

And the Acronym needs to be at least two letters long.

That being the case, try:

=====================================
Option Explicit
Private Function GenerateAcronym(ByVal s As String) As String
Dim re As Object
Dim sRes As String
Const sPat As String = "\b(OF|FOR|THE|AND|A)\b|\s*\b(([A-Z])|\S)\w+\b\s*"

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
re.Global = True
sRes = re.Replace(UCase(s), "$3")
If Len(sRes) <= 1 Then sRes = ""
GenerateAcronym = sRes
End Function
====================================
--ron
 
R

Ron Rosenfeld

Apologies in advance, I am NOT a coder, I am trying to fix VBA someone wrote
for me by 'slogging' through it on my own. Making some decent headway on
easier stuff but I am at an impasse.

He has a function that creates an Acronym out of a Value. However I want to
modify it so it ONLY does it if the # of words in that value > 1. Can anyone
give me a heads up on how to add that here please? It would be most
appreciated:

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") 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") 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

GenerateAcronym = UCase(res)

End Function
Click to expand...

Here's a bit shorter function using Regular Expressions that should accomplish
the same thing.

If I understand the rules correctly, the Acronym is formed by returning the
capitalized first letter of every word that starts with a letter (A-Za-z),
unless that word is OF, FOR, AND, A, THE

And the Acronym needs to be at least two letters long.

That being the case, try:

=====================================
Option Explicit
Private Function GenerateAcronym(ByVal s As String) As String
Dim re As Object
Dim sRes As String
Const sPat As String = "\b(OF|FOR|THE|AND|A)\b|\s*\b(([A-Z])|\S)\w+\b\s*"

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
re.Global = True
sRes = re.Replace(UCase(s), "$3")
If Len(sRes) <= 1 Then sRes = ""
GenerateAcronym = sRes
End Function
====================================
--ron
Click to expand...

Looking at the "simple fix" you posted to Dave's suggestion, I might change
mine to read:

=========================
Option Explicit
Private Function GenerateAcronym(ByVal s As String) As String
Dim re As Object
Dim sRes As String
Const sPat As String = "\b(OF|FOR|THE|AND|A)\b|\s*\b(([A-Z])|\S)\w+\b\s*"

Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
re.Global = True
sRes = re.Replace(UCase(s), "$3")
If Len(sRes) = 1 Then sRes = s
GenerateAcronym <= sRes
End Function
==============================

This returns the original string if the acronym generated is one letter (or
zero letters)

But some questions to think about.

What would you want returned if the initial string is:

For (an ignored word)
For Now (two words, but generates a single letter acronym).

--ron
 

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

Similar Threads

Removing Of/And/The from Acronym Function 0
Any idea why this is giving me a #Value! Error? 3
Enterprise Global Macros not valid for Project 0
Adding a VLookup to an AutoComplete ComboBox 0
Function to convert CUSIP code to ISIN code cusipconv() 1
Unexplained failure of wdFindStop at end of search 0
type mismatch error in macro in excel 0
VBA Coding Help for Beginner 0

Top