VBA Count Syllables

[anthonyexcel]

I have some code below that works fine except I


Than syllable rule is
1.) Count the vowels in the word
2.) Subtract any silent vowels, (like the "e" at the end of the word)
3.) Subtract every vowel from every dipthong (dipthongs only count as 1 vowel sound)

I have done 1 & 3 but am having a problem with 2. I assume it would be something like if right(txtin,1)="e" then but can't get it to work. Can someone please take a look thanks.

Works for everything but "e" at the end

<TABLE style="WIDTH: 157pt; BORDER-COLLAPSE: collapse" border=0 cellSpacing=0 cellPadding=0 width=209><COLGROUP><COL style="WIDTH: 61pt; mso-width-source: userset; mso-width-alt: 2962" width=81><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 61pt; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20 width=81>Ran</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; WIDTH: 48pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" width=64 align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>tommorrow</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>3</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Pane</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>2</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Pain</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>1</TD></TR><TR style="HEIGHT: 15pt" height=20><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; HEIGHT: 15pt; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" height=20>Came</TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0"></TD><TD style="BORDER-BOTTOM: #f0f0f0; BORDER-LEFT: #f0f0f0; BACKGROUND-COLOR: transparent; BORDER-TOP: #f0f0f0; BORDER-RIGHT: #f0f0f0" align=right>2</TD></TR></TBODY></TABLE>

Private Function CountSyllables(TxtIn As String) As Long
Dim x As Long
Dim l As Long
CountSyllables = 0
'Vowels
For x = 1 To Len(TxtIn)
Select Case UCase(Mid(TxtIn, x, 1))
Case "A", "E", "I", "O", "U", "Y"
    CountSyllables = CountSyllables + 1
Case Else
End Select
Next
'Dipthongs
For l = 1 To Len(TxtIn)
Select Case UCase(Mid(TxtIn, l, 2))
Case "AA", "AE", "AI", "AO", "AU", "AY", "EA", "EE", "EI", "EO", "EU", "EY", "IA", "IE", "II", "IO", "IU", "IY", "OA", "OE", "OI", "OO", "OU", "OY", "UA", "UE", "UI", "UO", "UU", "UY", "YA", "YE", "YI", "YO", "YU", "YY"
    CountSyllables = CountSyllables - 1
Case Else
End Select
 
Next
End Function

 

[Ralajer]

Try this. I also added some additional checks so that if the last letter was an 'e' it wouldn't be exclude for case where it wasn't a silent e. For words like me and be also for case where the word end in a dipthong

Private Function CountSyllables(TxtIn As String) As Long
    Dim x As Long
    Dim l As Long
    CountSyllables = 0
    'Vowels
    For x = 1 To Len(TxtIn)
        Select Case UCase(Mid(TxtIn, x, 1))
            Case "A", "E", "I", "O", "U", "Y"
                CountSyllables = CountSyllables + 1
            Case Else
        End Select
    Next
    'Dipthongs
    For l = 1 To Len(TxtIn)
        Select Case UCase(Mid(TxtIn, l, 2))
            Case _
            "AA", "AE", "AI", "AO", "AU", "AY", _
            "EA", "EE", "EI", "EO", "EU", "EY", _
            "IA", "IE", "II", "IO", "IU", "IY", _
            "OA", "OE", "OI", "OO", "OU", "OY", _
            "UA", "UE", "UI", "UO", "UU", "UY", _
            "YA", "YE", "YI", "YO", "YU", "YY"
            
                CountSyllables = CountSyllables - 1
            Case Else
        End Select
    Next
[B]    If CountSyllables > 1 And UCase(Right(TxtIn, 1)) = "E" Then
        Select Case UCase(Mid(TxtIn, Len(TxtIn) - 1, 1))
            '// Check if the second to last letter is a vowel
            Case "A", "E", "I", "O", "U", "Y"
                Exit Function
            '// Not a vowel silent E
            Case Else
                CountSyllables = CountSyllables - 1
        End Select
    End If[/B]
End Function

 

[Rick Rothstein]

This UDF seems to work correctly...

Private Function CountSyllables(TxtIn As String) As Long
  Dim X As Long
  For X = 1 To Len(TxtIn)
    '  Vowels
    If Mid(TxtIn, X, 1) Like "[AaEeIiOoUuYy]" Then CountSyllables = CountSyllables + 1
    '  Dipthongs
    If Mid(TxtIn, X, 2) Like "[AaEeIiOoUuYy][AaEeIiOoUuYy]" Then CountSyllables = CountSyllables - 1
  Next
  '  Silent "e"
  If Right(TxtIn, 3) Like "[AaEeIiOoUuYy][!AaEeIiOoUuYy]e" Then CountSyllables = CountSyllables - 1
End Function

Note the change in your silent "e" rule... I think the "e" is silent (for counting purposes) only when the word ends in vowel-consonent-e otherwise words like "double" and "triple" would be miscounted.

 

[Rick Rothstein]

Just as a follow-up to my last message, the code I posted can be "simplified" to this...

Private Function CountSyllables(TxtIn As String) As Long
  Dim X As Long
  For X = 1 To Len(TxtIn)
    '  Vowels
    CountSyllables = CountSyllables - (Mid(TxtIn, X, 1) Like "[AaEeIiOoUuYy]")
    '  Dipthongs
    CountSyllables = CountSyllables + (Mid(TxtIn, X, 2) Like "[AaEeIiOoUuYy][AaEeIiOoUuYy]")
  Next
  '  Silent "e"
  CountSyllables = CountSyllables + (Right(TxtIn, 3) Like "[AaEeIiOoUuYy][!AaEeIiOoUuYy]e")
End Function

 

[Ruddles]

<deleted>

 

[Rick Rothstein]

How does your code cope with "fiance"?

Theoretically, that is not an "e" at the end, it should be an é instead.

The real answer to your implied question, though, is that the English language has so many "rule breakers" that I don't think any general algorithm could work for all of them.

 

[Ruddles]

Also the "ia" is two syllables.

Yes, I realised a final "é" could be coded around as soon as I posted it. You replied before I could delete it!

Is there nothing in Word? It has a word count.

 

[Rick Rothstein]

Also the "ia" is two syllables.

Ah, "ia" is a tricky one and it may not be possible to program around it. For words like "amiable" and "spepia", it forms two syllables; however, for words like "special" and "substantial" it doesn't. At first I thought that if it were followed by an "l" then maybe it was always pronounced as one syllable, but then the words "trial" and "dial" came to mind to refute that. It kind of looks like that letter combination will not be able to be successfully incorporated into a program to count syllables. I'm guessing there exists other letter combinations that will prove to be equally troubling out there as well.

 

[anthonyexcel]

Thank you everyone for the replies! Rick Rothstein you are right there are other combinations and sequences that have to take place but this is a good starter! Thank you all again foryour help! I am now Working on words like "sequoia" that breaks the mold! Thanks again!

 

[Rick Rothstein]

Thank you everyone for the replies! Rick Rothstein you are right there are other combinations and sequences that have to take place but this is a good starter! Thank you all again foryour help! I am now Working on words like "sequoia" that breaks the mold! Thanks again!

Another double vowel combination to watch out for is "oe"... toe is one syllable where as poet is two. I'm sure there are many more "gotcha" as well.