Check for # of Words in Function
 

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

Check for # of Words in Function
 

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

msnyc07 wrote:

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

--

Dave Peterson

Check for # of Words in Function
 

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.

"Dave Peterson" wrote:

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

msnyc07 wrote:

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

--

Dave Peterson
.