Count Letters In a String

[DroopyPawn]

Is there a VB function to return the number of characters A, in a string B?
For example I want to know how many times the letter "a" occurs in the word "aardwolf", the function should return 2.

Right now I'm doing the following slow code. I need something faster.

Public Function CountLetters(w$, ltr$) As Integer
    Dim i As Integer, c$, Count As Integer
    For i = 1 To Len(w$)
        c$ = Mid$(w$, i, 1)
        If c$ = ltr$ Then Count = Count + 1
    Next i
    CountLetters = Count
End Function

[DroopyPawn]

I've optimized it a to the following code which is about twice as fast for my purposes. I'd still need a little more speed.

Public Function CountLetters(w$, ltr$) As Integer
    Dim i As Integer, Count As Integer, StartLetter As Integer
    StartLetter = InStrB(w$, ltr$)
    If StartLetter <> 0 Then
        For i = StartLetter To Len(w$)
            'c$ = Mid$(w$, i, 1)
            If Mid$(w$, i, 1) = ltr$ Then Count = Count + 1
        Next i
    End If
    CountLetters = Count
End Function

It's funny how adding MORE code can sometimes speed up the process.

[jcis]

Private Sub Command1_Click()
    MsgBox GetCharCount("aardwolf", "a", False)
End Sub

Private Function GetCharCount(pString As String, pChar As String, pCaseSense As Boolean)
    If Not pCaseSense Then
        pString = UCase(pString)
        pChar = UCase(pChar)
    End If
    GetCharCount = Len(pString) - Len(Replace(pString, pChar, vbNullString))
End Function

3erd parameter is for case sense.

[Edgemeal]

Public Function CountLetters(w As String, ltr As String) As Integer
    CountLetters = UBound(Split(w, ltr))
End Function

[DroopyPawn]

Edgmeal, could you explain what that code is doing? It seems to work but I don't understand how.

[DroopyPawn]

Now I've found that my "optimized code" has a bug. When I loop from asc("a") to asc("z"), it returns the correct value for "a", but zeroes on all the others. I can't see the mistake.

I'm going to use Edgemeal's code but I still would like know where I erred in my code.

[Edgemeal]

Edgmeal, could you explain what that code is doing? It seems to work but I don't understand how.

Split returns a zero-based one-dimensional array, setting it's delimiter tells it what to use to separate the string into the array.

UBound returns the largest dimension of an array.

You could also use that call to count more then a single letter, like if the search letter is "pp" and the word was "apple" it would return 1.

EDIT As far as speed goes I've never tested the code, but if you are calling it multiple times in a row from a loop for example you'd be better off using it directly inline with your code, calling it as as a sub or function will be slower.

[DroopyPawn]

Ok that makes sense now and also helps me with another problem....

If I add a "ListOfWords.txt" as a compiled resource and then get the "list of words" into a string, I could split the string into an array using vbCrLf as the delimiter, right?

[DroopyPawn]

Edgemeal, is there a similarly simple/fast way to covert a string into an array of characters?
Right now, I'm looping from 1 to len(w$) and using mid() to copy each letter into an array.

[Merri]

Easy way: copy string to byte array.

Dim bytChar() As Byte

bytChar = "ABC"

Debug.Print bytChar(0), bytChar(2), bytChar(4)


And an incredibly fast way:

Option Explicit

Private Declare Sub PutMem4 Lib "msvbvm60" (ByVal Ptr As Long, ByVal Valule As Long)
Private Declare Function VarPtrArray Lib "msvbvm60" (Arr() As Any) As Long

Private Sub Form_Load()
    Dim intChar() As Integer, lngHeader(5) As Long, strSample As String

    strSample = "ABCD"

    ' create a custom one dimensional SAFEARRAY
    lngHeader(0) = 1
    lngHeader(1) = 2
    lngHeader(3) = StrPtr(strSample)
    lngHeader(4) = Len(strSample)

    ' use that header for intChar array
    PutMem4 VarPtrArray(intChar), VarPtr(lngHeader(0))

    ' just show what we now have in the array
    Debug.Print intChar(0), intChar(1), intChar(2), intChar(3)

    ' important to clean up before exiting procedure
    PutMem4 VarPtrArray(intChar), 0
End Sub

[DroopyPawn]

I tried the array code but I have an error somewhere. Still working on it though.

Is there a way I can time the code to see exactly how fast it's running and how changes that I make affect the speed? I know there is but I haven't gotten it to work yet. I tried doing something with NOW but that didn't work.

[Merri]

Check Timings.bas at http://kontu.selfip.info/vb6/projects/Modules/

' initialize
Timing = 0

' show the time
Debug.Print Format$(Timing, "0.000000")


Oh, and the code I posted was untested simply for the reason of not having VB6. The time being what it is I won't test it right now either.

[Edgemeal]

If I add a "ListOfWords.txt" as a compiled resource and then get the "list of words" into a string, I could split the string into an array using vbCrLf as the delimiter, right?

Heres one way to load a text file into a string array.

Option Explicit

Private Sub Command1_Click()

    Dim i As Long
    Dim MyArray() As String
    FileToArray "SomeFile.txt", MyArray
    
    For i = 0 To UBound(MyArray)
        ' ignore blank lines
        If Len(MyArray(i)) > 0 Then Debug.Print MyArray(i)
    Next i

End Sub

Private Sub FileToArray(ByVal sPath As String, ByRef sArray() As String)
    Dim ff As Integer
    ff = FreeFile
    On Error GoTo Fini
    Open sPath For Input As #ff
    sArray = Split(Input(LOF(ff), ff), vbCrLf)
Fini:
    Close #ff
End Sub

[DroopyPawn]

What's the advantage to loading the file that way rather than reading each word in the file one at a time in a While Not EOF Loop?

Also, I don't want to read from a text file on the hard drive. I want to read from a file in the application's resources.

Last night, I got my code to recognize the compiled text file in the app, but when I put the text into a TextBox, all I got was question marks. It was nothing close to my expected list of words.

[Edgemeal]

I believe Input LOF loads the whole file in one step, its definitely faster then reading one line at a time, but if you are loading from a resource file then it won't do you any good.

[anhn]

Both Split() and Replace() methods are much faster than Instr() method.
You should add CompareMethod to make them completed.

Split() is faster than Replace() if use vbTextCompare
Replace() is faster than Split() if use vbBinaryCompare

Public Function CountSubstr1(sText As String, sSubstr As String, _
                             Optional Compare As VbCompareMethod = vbTextCompare) As Integer
    CountSubstr1 = UBound(Split(sText, sSubstr, , Compare))
End Function

Public Function CountSubstr2(sText As String, sSubstr As String, _
                             Optional Compare As VbCompareMethod = vbTextCompare) As Integer
    CountSubstr2 = Len(sText) - Len(Replace(sText, sSubstr, "", , , Compare))
End Function

[Merri]

InStrB method, just for counting one letter, is much faster than Split or Replace.

Public Function CountLetters(ByRef Text As String, ByRef Letter As String) As Long
    Dim lngA As Long, strL As String * 1
    strL = Letter
    strL = LCase$(strL)
    lngA = InStrB(Text, strL)
    Do While lngA > 0
        CountLetters = CountLetters + (lngA And 1)
        lngA = InStrB(lngA + 1, Text, strL)
    Loop
    strL = UCase$(strL)
    lngA = InStrB(Text, strL)
    Do While lngA > 0
        CountLetters = CountLetters + (lngA And 1)
        lngA = InStrB(lngA + 1, Text, strL)
    Loop
End Function

InStrB is faster than InStr, but requires extra tricks. In this case, (lngA And 1) to ensure we found a start of character.