excel vba about sum up number of multiple words

[huiyin9218]

Hi,

How do i write a code to count total of "blue" and "red" in each school? The sum of blue and red have to be written at the cell next to the school.
Colors other than blue and red are ignored. The rows in each school is inconsistent.


[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]AB School[/TD]
[TD="align: center"]4[/TD]
[/TR]
[TR]
[TD]Blue[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Blue[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Red[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Red[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]CD School[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD]Red[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Yellow[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

I would be so grateful for your help.

 

[vds1]

If the first column is A and Result in Column B then try the below code :

Sub countBlueRed()
    Dim i           As Long
    Dim j           As Long
    Dim Counter     As Long
    Dim iCount      As Long
    iCount = Range("A" & Rows.count).End(xlUp).Row
    For i = 1 To iCount
        If InStr(UCase(Range("A" & i).Value), "SCHOOL") > 0 Then
            Counter = 0
            For j = i + 1 To iCount
               If InStr(UCase(Range("A" & j).Value), "SCHOOL") > 0 Then Exit For
                    If UCase(Range("A" & j).Value) = "BLUE" Or UCase(Range("A" & j).Value) = "RED" Then
                        Counter = Counter + 1
                    End If
            Next j
            Range("B" & i).Value = Counter
        End If
    Next i
End Sub

 

[Fluff]

Another option

Sub SumSchools()
   Dim Rng As Range
   With Range("B1", Range("A" & Rows.Count).End(xlUp).Offset(, 1))
      .Value = Evaluate(Replace("if(isnumber(search(""school"",@)),true,"""")", "@", .Offset(, -1).Address))
      For Each Rng In .SpecialCells(xlBlanks).Areas
         Rng.Offset(-1).Resize(1).Value = Application.CountIf(Rng.Offset(, -1), "red") + Application.CountIf(Rng.Offset(, -1), "blue")
      Next Rng
   End With
End Sub