What is wrong with my math in Excel VBA? - 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