我在VBA代码中的操作顺序有什么问题？

Question

I have this Excel spreadsheet that I am trying to create a working macro (in VBA) that when a cell containing a date (dates in order by a row in the B column), and this cell is in a specific color, and this cell is active, and the user clicks on a button, the macro searches for all the dates equal to the date in the active cell and to its color. Then in column H, the number value of the respective rows to the found dates are added up and stored into a variable called totalValue Then afterwards, the date, description, and the totalValue are copied over to another sheet and pasted in the next available predefined row.

I know that the color sort works for one color, I am using more than one color layout. The problem is when I run the macro, it seems to add all the number values in Column H within the date and it does not filter out the colors. But, when I take out block of code for "if color equals this, then do math" in lines 52 & 53 ( ElseIf rFound.Style.Name = "Shipping" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet" ) then the color value for the code above that in lines 49 & 50 works ( ElseIf rFound.Style.Name = "Office" Then totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet" ), but not the code above that lines 46 & 47 unless I take out the code in lines 49 & 50 as well, otherwise it would still add all the values in Column E.

What am I doing wrong? How can I fix it so that it can find the dates in a set color and be able to have several set colors available for use without this addition problem?

The code in question starts at 'BEGINNING OF HELP SEGMENT and ends at 'END OF HELP SEGMENT . The code above, between 'BEGINNING of Search function for HELP SEGMENT and 'ENG of Search function for HELP SEGMENT is the gathering of search parameters.

Here is my code:

Sub Copy_and_Move_Jul()
'
' Copy_and_Move From July Payable Ledger to Jul Summary Macro
'

'BEGINNING of Search function for HELP SEGMENT
'********************************************
    'Declare Var

    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

    ' GET & SEARCH FOR COLOR AND DATE OF ACTIVE CELL, AND GET THE VALUES IN COLUMN H AND RETURN VALUE TO "totalValue"

    ' set search range
    Set SearchRange = Range("B7:B56")

    ' 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 date column 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)


'********************************************
ENG of Search function for HELP SEGMENT


' BEGINNING OF HELP SEGMENT
'********************************************************************************************************************

    ' 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 = "Marketing" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Inventory" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Office" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            ElseIf rFound.Style.Name = "Shipping" Then
                totalValue = totalValue + rFound.Offset(0, 6).Value ' THIS VALUE GOES TO Column E "Summary Sheet"

            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 of the Color & Date search
'********************************************************************************************************************    
' END OF HELP SEGMENT    

    'Select & copy Columns B - I of Row of Active Cell

    Range("B" & ActiveCell.Row & ":G" & ActiveCell.Row).Select
    Selection.Copy

    'Go to "Summary" Sheet & Paste data in next available empty Row

    Sheets("Summary").Select
    Range("B56").End(xlUp).Offset(1, 0).Select
    ActiveSheet.Paste

    'Select Column D & delete unneeded Qty # and input a "y" for "Expsense"
    Range("D" & ActiveCell.Row).Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "y"

    'Set Value of Column H

    Range("E" & ActiveCell.Row) = totalValue


    'Goto Column C, Check Cell Style and input where supplies came from

    Range("C" & ActiveCell.Row).Select

    If Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Marketing" Then
        ActiveCell.FormulaR1C1 = "Marketing Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Inventory" Then
        ActiveCell.FormulaR1C1 = "Inventory Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Office" Then
        ActiveCell.FormulaR1C1 = "Office Supplies"

    ElseIf Worksheets("Summary").Range("C" & ActiveCell.Row).Style.Name = "Shipping" Then
        ActiveCell.FormulaR1C1 = "Shipping Supplies"

    End If

End Sub

Here is a picture, before taking out the code in lines 52 & 53, I hope this helps with my explanation as to what is happening:

Here is a picture, after taking out the code in lines 52 & 53, this is what it's supposed to do:

Much appreciation in advance!

Answer 1

Start by checking if all the style names in the search range have the expected values:

Sub styleNames()

    Dim cl As Range, SearchRange As Range

    Set SearchRange = Range("B7:B56")

    For Each cl In SearchRange
        If cl.Value <> vbNullString Then _
            Debug.Print " row: " & cl.Row & " style name: " & cl.Style.name
    Next cl

End Sub

If they do, then you know for sure it's your code which is the problem. Try rewriting it in a simpler and less convoluted way by introducing conditional statements in the for each loop instead.