Counting How Many Rows Have A Certain Criteria in Each Row's String-CodePudding

I am trying to count how many rows in a column have a certain criteria in their string. Example data is below:

96.001
96.001
96.002
97.0052
1201 - Mining
1201 - Drilling
1205 - Safety

This data occurs in column F. I want the code to check the column and count how many different cells contain a decimal in them & assign that count to a variable. So if the variable was X, in the above case X = 4.

Really been stuck on this and would appreciate any help.

CodePudding user response：

As mentioned in the comments, load the data into the array and use Int:

Sub foo()
    Dim arr() As Variant
    arr = Range("F2:F8").Value
    
    Dim i As Long
    For i = LBound(arr, 1) To UBound(arr, 1)
        If Int(arr(i, 1)) <> arr(i, 1) Then
            Dim count As Long
            count = count   1
        End If
    Next
    
    Debug.Print count ' returns 4
End Sub

EDIT:

Given your updated sample data, perhaps the following?

Sub foo()
    Dim count As Long
    count = Application.CountA(Range("F2:F8")) - Application.CountIfs(Range("F2:F8"), "*-*")
End Sub

This is equivalent to counting all populated cells that do not contain a -.

EDIT 2:

Even easier, as noted by @FunThomas, just use Count:

Count = Application.Count(Range("F2:F8"))

CodePudding user response：

Count Cells Containing String

This example counts cells containing periods no matter what they represent (e.g. just a period, a date, a decimal, or a thousand separator).

Sub CountCellsContainingStringTEST()
    
    Const RANGE_ADDRESS As String = "F2:F8"
    Const CHAR As String = "."
    
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    Dim rg As Range: Set rg = ws.Range(RANGE_ADDRESS)
    
    Dim x As Long: x = CountCellsContainingString(rg, CHAR)
    
    MsgBox x

End Sub

Function CountCellsContainingString( _
    ByVal rg As Range, _
    ByVal SearchString As String, _
    Optional ByVal MatchCase As Boolean = False) _
As Long
    
    Dim CompareMethod As VbCompareMethod
    If MatchCase Then
        CompareMethod = vbBinaryCompare
    Else
        CompareMethod = vbTextCompare
    End If
    
    Dim cell As Range
    For Each cell In rg.Cells
        If InStr(1, cell.Text, SearchString, CompareMethod) > 0 Then
            CountCellsContainingString = CountCellsContainingString   1
        End If
    Next cell
    
End Function