How to count the total number of specific words in a cell and do the same for other cells as well using VBA?

Question

How do I count the total number of "alt" and "first" that appeared in a cell and do the same for other cells as well while ignoring empty cells in the process? For instance, if a cell has first, first, alt, first, first, first, it should give me firstcounter = 5 (where firstcounter is the total count for first) and altcounter= 1(altcounter is the total count for alt). After that I can use the value of firstcounter and altcounter found to concatenate them into a string as shown in column B in the form of "first-" & firstcounter, "alt-"& altcounter.

Dim ia As Long
Dim lastrow2 As Long
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Sheets(1)
lastrow2 = ws1.Range("A" & ws1.Rows.count).End(xlUp).Row
For ia = 2 To lastrow2
  Dim arr() As Variant
    ' Split the string to an array
arr = Split(ws1.Cells(ia, "A"), ",").Value
'what should i do after split

Include your own attempt on VBA please. You might be rather close to a solution. I guess you have at least found out about `Split`? — JvdV, Mar 16 '20 at 07:46
@JvdV im not sure whether did i do the split correctly as shown in my updated post but after that how do i count them? — cena, Mar 16 '20 at 07:55

Excel Hero · Accepted Answer · 2020-03-16T08:35:51.360

Enter the following into a code module...

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

Then in cell B2 enter this formula:

=CountWords(A2)

Now copy it downwards as far as you need.

Update

To use the above function from VBA without entering formulas in the worksheet you can do it like this...

Sub Cena()
    Dim i&, v
    With [a2:a8]
        v = .Value2
        For i = 1 To UBound(v)
            v(i, 1) = CountWords(v(i, 1))
        Next
        .Offset(, 1) = v
    End With
End Sub

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

Update #2

In response to your questions in the comments, you can use this variation instead...

Sub Cena()
    Dim i&, v
    With [a2].Resize(Cells(Rows.Count, 1).End(xlUp).Row - 1)
        v = .Value2
        For i = 1 To UBound(v)
            v(i, 1) = CountWords(v(i, 1))
        Next
        .Cells = v
    End With
End Sub

Function CountWords$(r)
    Dim a&, f&, w
    For Each w In Split(r, ",")
        If w = "alt" Then a = a + 1
        If w = "first" Then f = f + 1
    Next
    If (a + f) Then CountWords = "first-" & f & ",alt-" & a
End Function

hey thanks alot, but is there a way to make this happen after i ran the programme with VBA without having to use the additional step =CountWords(A2) step? — cena, Mar 16 '20 at 08:04
it works really good! Anyways as i am trying to make it possible from 2nd to lastrow, when i replaced With [a2:a8] into With ["a2:a"&lastrow2] where lastrow2 = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row, it shows the object required error on v = .Value2. Why is this so? — cena, Mar 16 '20 at 08:23
Also i intend to replace my column A with the output that is found instead of showing the output on column B tho so this means .Offset(, 1) = v is not required? — cena, Mar 16 '20 at 08:26
You can't use the square brackets with variables. You have to use the verbose form of Evaluate. — Excel Hero, Mar 16 '20 at 08:26
Nice & simple :+) FYI, posted an alternative using the `Filter()` function. — T.M., Mar 17 '20 at 10:48

Storax · Answer 2 · 2020-03-16T08:58:22.693

In order to make this independent from the words alt and first and whitespaces in the string I would use the following functions

Option Explicit

'Add a reference to Microsoft VBScript Regular Expressions 5.5
Public Function RemoveWhiteSpace(target As String) As String
    With New RegExp
        .Pattern = "\s"
        .MultiLine = True
        .Global = True
        RemoveWhiteSpace = .Replace(target, vbNullString)
    End With
End Function

'Add a reference to Microsoft Scripting Runtime
Function CountWordsA(rg As Range) As String

    On Error GoTo EH

    Dim dict As Dictionary
    Set dict = New Dictionary

    Dim vDat As Variant
    vDat = RemoveWhiteSpace(rg.Value)
    vDat = Split(vDat, ",")


    Dim i As Long
    For i = LBound(vDat) To UBound(vDat)
        If dict.Exists(vDat(i)) Then
            dict(vDat(i)) = dict(vDat(i)) + 1
        Else
            dict.Add vDat(i), 1
        End If
    Next i


    Dim vKey As Variant
    ReDim vDat(1 To dict.Count)
    i = 1
    For Each vKey In dict.Keys
        vDat(i) = vKey & "-" & dict(vKey)
        i = i + 1
    Next vKey

    CountWordsA = Join(vDat, ",")

    Exit Function

EH:
    CountWordsA = ""

End Function

Sub TestIt()

    Dim rg As Range
    Set rg = Range("A2:A8")
    Dim sngCell As Range

    For Each sngCell In rg
        sngCell.Offset(, 1) = CountWordsA(sngCell)
    Next sngCell
End Sub

More about dictionaries and regular expressions

You are welcome. As said, this function is independent from the words and will also take strings like _first, second, alt , second, alt_ with the result _first-1,second-2,alt-2_. And it will also remove whitepsaces especially blanks beforehand. — Storax, Mar 16 '20 at 08:55

score 1 · Answer 3 · answered Mar 17 '20 at 10:10

Alternative using Filter() function

This demonstrates the use of the Filter() function to count words via function UBound():

Function CountTerms() (usable also in formulae)

Function CountTerms(ByVal WordList As String, Optional TermList As String = "first,alt", Optional DELIM As String = ",") As String
'Purpose: count found terms in wordlist and return result as list
    '[1] assign lists to arrays
    Dim words, terms
    words = Split(WordList, DELIM): terms = Split(TermList, DELIM)

    '[2] count filtered search terms
    Dim i As Long
    For i = 0 To UBound(terms)
        terms(i) = terms(i) & "-" & UBound(Filter(words, terms(i), True, vbTextCompare)) + 1
    Next i
    '[3] return terms as joined list, e.g. "first-5,alt-1"
    CountTerms = Join(terms, ",")
End Function

Example call (due to comment) & help function getRange()

In order to loop over the entire range and replace the original data with the results list:

Sub ExampleCall()
    '[1] get range data assigning them to variant temporary array
    Dim rng As Range, tmp
    Set rng = getRange(Sheet1, tmp)       ' << change to sheet's Code(Name)

    '[2] loop through array values and get counts
    Dim i As Long
    For i = 1 To UBound(tmp)
        tmp(i, 1) = CountTerms(tmp(i, 1))
    Next i
    '[3] write to target (here: overwriting due to comment)
    rng.Offset(ColumnOffset:=0) = tmp

End Sub

Function getRange(mySheet As Worksheet, tmp) As Range
'Purpose: assign current column A:A data to referenced tmp array
With mySheet
    Set getRange = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    tmp = getRange          ' assign range data to referenced tmp array
End With
End Function

How to count the total number of specific words in a cell and do the same for other cells as well using VBA?

3 Answers3