VBA counting substrings in a string across a range - excel

Question

I have been working on a worksheet in Excel and im trying to get accurate number of sub strings within a string across a range. Im using columns C and D that have text them im adding the following code to get a number of the occurrences of particular words and total them in column H by using a public function. I cannot get the code to span a range and bring back the answer. Maybe there is a better way.?
Option Compare Text
Function CountString(FullString As String, PartialString As String) As Integer
Dim cnt As Integer
cnt = 0
For i = 1 To Len(FullString)
If Mid(FullString, i, Len(PartialString)) = PartialString Then
cnt = cnt + 1
End If
Next i
CountString = cnt
End Function

Answer 1

A = "CatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDog"
Msgbox UBound(Split(A, "Dog"))
This counts how many times dog appears in the string by using dog as a delimiter then counting how many elements in the array.
edit
Application of technique for OP:
Function CountString(FullString As String, PartialString As String) As Integer
CountString = UBound(Split(FullString, PartialString))
End Function
Edit 2
Set regEx = New RegExp
A="DogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCat"
regEx.Pattern = "dog"
regEx.IgnoreCase = True
regEx.Global = True
Set MyMatches = regEx.Execute(A)
Msgbox MyMatches.Count
This counts the delimiter.
You have .test which returns true/false, .Execute which returns a collections of matches, and .replace which has many uses including replace and extracting parts of files.

Answer 2

Instead of your loop, I would use one single statement like
Function CountString(FullString As String, PartialString As String) As Integer
CountString = (Len(FullString) - Len(Replace(FullString, PartialString, ""))) / Len(PartialString)
End Function
(from here)

Answer 3

All the credit for the next code must go to #Mark. But, if on some installations the code returns wrong, please use the next variant:
Function CountString(FullString As String, PartialString As String) As Long
CountString = UBound(Split(FullString, PartialString))
If UBound(Split("x", "x")) = 2 Then CountString = CountString - 1
End Function
The way or function using to count total occurrences in a range, would be the next:
Sub countStringsInRange()
Dim sh As Worksheet, rng As Range, TotCount As Long, cel As Range, strSearch As String
strSearch = "Dog"
Set sh = ActiveSheet ' use here your sheet
Set rng = sh.Range("C8:D8") 'use here whatever range you need
For Each cel In rng
TotCount = TotCount + CountString(cel.Value, strSearch)
Next
Debug.Print TotCount
End Sub
After editing:
The next function is able to also process arrays (it works for strings, too):
Function CountStringArr(FullString As String, PartialString As Variant) As Long
Dim El As Variant, iCount As Long
If IsArray(PartialString) Then
For Each El In PartialString
iCount = iCount + UBound(Split(FullString, El))
Next
CountStringArr = iCount
Else
CountStringArr = UBound(Split(FullString, PartialString))
End If
End Function
It can be called as in the next example:
Dim x As String
x = "CatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDogCatDog"
Debug.Print CountStringArr(x, Array("Dog", "Cat")) 'it returns 20
Debug.Print CountStringArr(x, "Dog") 'it returns 10
And it can be called from a range in the next way:
Sub countStringsInRangeBis()
Dim sh As Worksheet, rng As Range, TotCount As Long, cel As Range, strSearch As Variant
strSearch = Split("Dog,Cat", ",") 'or Array("Dog", "Cat")
Set sh = ActiveSheet ' use here your sheet
Set rng = sh.Range("C8:D8") 'use here whatever range you need
For Each cel In rng
TotCount = TotCount + CountStringArr(cel.Value, strSearch)
Next
Debug.Print TotCount
End Sub

Answer 4

Count Substrings (In a Range)
Function countString(SourceString As Range, _
ByVal SubString As String, _
Optional ByVal ignoreCase As Boolean = False) _
As Long
Dim Data As Variant, Curr As Variant
Dim i As Long, j As Long, Result As Long, iCase As Long
If ignoreCase Then iCase = 1
Data = SourceString.Value
If IsArray(Data) Then
GoSub CaseArray
Else
GoSub CaseValue
End If
countString = Result
Exit Function
CaseArray:
For i = 1 To UBound(Data)
For j = 1 To UBound(Data, 2)
Curr = Data(i, j): GoSub countValue
Next j
Next i
Return
CaseValue:
Curr = Data: GoSub countValue
Return
countValue:
If Not IsError(Curr) Then
Result = Result + UBound(Split(Curr, SubString, , iCase))
' Result = Result + (Len(Curr) _
- Len(Replace(Curr, SubString, "", , , iCase))) / Len(SubString)
End If
Return
End Function