Sum up text

[adam]

The following code works for the text mentioned in the code. I want to include more texts in the code to sum up.

Such include LIVEMATCHING (ROUTINE), AB-CB, S. REAL, “O”, HE I & II SHE, LETS ABC1D.

Code: Select all

Sub CountOccurrencesForDate()
    Dim wsVaga As Worksheet
    Dim wsTblResults As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim count As Long
    Dim searchDate As Date
    
    Set wsVaga = ThisWorkbook.Sheets("vaga")
    Set wsTblResults = ThisWorkbook.Sheets("tblResults")
    
    searchDate = wsVaga.Range("B1").Value
    lastRow = wsTblResults.Cells(wsTblResults.Rows.count, "A").End(xlUp).Row
    count = 0
    
    For i = 5 To lastRow
        If wsTblResults.Cells(i, 1).Value = searchDate And wsTblResults.Cells(i, 4).Value = "SERUM CHLORIDE" Then
            count = count + 1
        End If
    Next i
    
    wsVaga.Range("B2").Value = count
End Sub

Any help would be kindly appreciated. Thanks in advance.

[HansV]

For example:

Code: Select all

Sub CountOccurrencesForDate()
    Dim wsVaga As Worksheet
    Dim wsTblResults As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim count As Long
    Dim searchDate As Date

    Set wsVaga = ThisWorkbook.Sheets("vaga")
    Set wsTblResults = ThisWorkbook.Sheets("tblResults")

    searchDate = wsVaga.Range("B1").Value
    lastRow = wsTblResults.Cells(wsTblResults.Rows.count, "A").End(xlUp).Row
    count = 0

    For i = 5 To lastRow
        If wsTblResults.Cells(i, 1).Value = searchDate Then
            Select Case wsTblResults.Cells(i, 4).Value
                Case "SERUM CHLORIDE", "LIVEMATCHING (ROUTINE)", "AB-CB", "S. REAL", "“O”", "HE I & II SHE", "LETS ABC1D"
                    count = count + 1
            End Select
        End If
    Next i

    wsVaga.Range("B2").Value = count
End Sub

Remark: I have assumed that the curly quotes around O are part of the text. If not, change "“O”" to "O" in the code.

[snb]

Use Autofilter

Code: Select all

Sub M_snb()
  With Sheet1.UsedRange
    .AutoFilter 1, Sheet2.Cells(1, 2).Text
    .AutoFilter 4, Array("SERUM CHLORIDE", "LIVEMATCHING (ROUTINE)", "AB-CB", "S. REAL", "“O”", "HE I & II SHE", "LETS ABC1D"), 7
    Sheet2.Cells(2, 2) = .Columns(1).SpecialCells(12).count - 1
    .AutoFilter
  End With
End Sub

Avoid in VBA redundant interaction with the workbook, use Arrays instead.
In this case MS has already provided a simple method.