What is wrong with my math in Excel VBA?

Question

Hopefully this my last question on this project of mine. I asked this question over at yahoo so I don't ask too many questions here, but no one has gotten back.

In Excel VBA code I am trying to add the values in Column H after doing a search in Column B for same date and highlight color. I have the code to loop to search and find the matching cells and perform the math operations that I want. The math operations is to get the value of Column H of the same Row of the Column B found with the search criteria. When I run the macro, it takes the value of Column H of the active row, and the result is multiplied by the number of cells found, not adding each value to get the sum.

For Example, the sum that I am looking for is 85, but the answer from the macro is 15 because the value of Column H in the active row is 3 and there are 5 cells that match the search criteria.

I know this for when I didn't incude the starting cell, the answer was 12, because there were 4 cells.

Example of what I am looking for: I select the last green highlighted cell with the date of "7/22/2016" (cell B15) I want to get the value of Column H of that same row (this would be H15) and add only the Column H values that have a green highlighted date "7/22/2016" (cells; H15+H7+H3+H2+H1) which should equal 85

What am I doing wrong with my math in my code? And how can I fix it? I have the search function working. I just need to get the selected row value and add the other search matching Column H values.

With the help of user [tag:Thomas Inzina], I was able to come up with this code:

Sub FindMatchingValue()
    Const AllUsedCellsColumnB = False
    Dim rFound As Range, SearchRange As Range
    Dim cellValue As Variant, totalValue As Variant

    ' Get the H value of active row and set it to totalValue
    cellValue = Range("H" & ActiveCell.Row)
    totalValue = cellValue

    ' set search range
    If AllUsedCellsColumnB Then
        Set SearchRange = Range("B1", Range("B" & Rows.Count).End(xlUp))
    Else
        Set SearchRange = Range("B1:B30")
    End If

    ' If there is no search range, show Msg
    If Intersect(SearchRange, ActiveCell) Is Nothing Then
        SearchRange.Select
        MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
        Exit Sub
    End If

    ' Get search criteria & set it to rFound
    Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
                                  After:=ActiveCell, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  SearchFormat:=False)


    ' If rFound is not Nothing, then do math. If rFound is Nothing, then findnext
    If Not rFound Is Nothing Then

        Do

            If rFound.Style.Name = "Good" Then

                totalValue = totalValue + cellValue

            End If

            Set rFound = SearchRange.FindNext(rFound)

        ' Loop till all matching cells are found
        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If

    Range("D1") = totalValue ' Show value in test cell to see if math works

End Sub

Here is a picture of the spreadsheet

Edit 1: below is the code that the user [tag:Thomas Inzina] help me come up with.

Sub FindMatchingValue()
    Const AllUsedCellsColumnB = False
    Dim rFound As Range, SearchRange As Range
    ' DOES NOT HAVE "cellValue" or "totaValue"

    If AllUsedCellsColumnB Then
        Set SearchRange = Range("B1", Range("B" & Rows.Count).End(xlUp))
    Else
        Set SearchRange = Range("B1:B30")
    End If

    If Intersect(SearchRange, ActiveCell) Is Nothing Then
        SearchRange.Select
        MsgBox "You must select a cell in the highlighted area before continuing", vbInformation, "Action Cancelled"
        Exit Sub
    End If

    Set rFound = SearchRange.Find(What:=ActiveCell.Value, _
                                  After:=ActiveCell, _
                                  LookIn:=xlValues, _
                                  LookAt:=xlPart, _
                                  SearchOrder:=xlByRows, _
                                  SearchDirection:=xlNext, _
                                  SearchFormat:=False)



    If Not rFound Is Nothing Then

        Do

            If rFound.Style.Name = "Good" Then

                Range("H" & rFound.Row).Interior.Color = vbRed 'THIS IS THE MAIN CHANGE

            End If

            Set rFound = SearchRange.FindNext(rFound)

        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If

End Sub

And this is a picture of what the code does.

What I want is instead of highlighting the red, is to find the sum of these red cells and the cell that is not highlighted but is original search source (cell H15), then take the sum of these and assign it to a variable such as ' totalValue'

Answer 1

Use the following as the section doing the math. It will add the value from the line where the find occurs (rather than the initial value) and it will also avoid counting the initial value twice if it is the only match.

' If rFound is not Nothing, then do math. If rFound is Nothing, then findnext
If Not rFound Is Nothing Then
    If rFound.Address <> ActiveCell.Address Then
        Do

            If rFound.Style.Name = "Good" Then

                totalValue = totalValue + rFound.Offset(0, 6).Value

            End If

            Set rFound = SearchRange.FindNext(rFound)

        ' Loop till all matching cells are found
        Loop While Not rFound Is Nothing And rFound.Address <> ActiveCell.Address
    End If
End If