If column A contains “column D” AND column B contains “column E” THEN add value

Question

I'd like to write a macro that reads words in Column A and B, to see if they match words in Column E and F respectively, then adds the value in Column C to Column G.

For example:

You can see, for example, that there are two instances of "Lion" and "Horse" in Columns A and B, so Column G has the total of the two (10 + 8 = 18).

Unfortunately, the attempt I made just copies the values from Column C to Column G:

Sub CombineAnimals()

lastRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

For x = 1 To lastRow
    If InStr(1, Sheets("Sheet1").Cells(x, 1), Cells(x, 5)) <> 0 _
    And InStr(1, Sheets("Sheet1").Cells(x, 2), Cells(x, 6)) <> 0 Then
        Sheets("Sheet1").Cells(x, 7).Value = _
        Sheets("Sheet1").Cells(x, 7).Value + Cells(x, 3)
    End If
Next x

End Sub

I know I'm doing something wrong with the "x" (and probably many other things), but I can't figure out a way to make it work. Is there any way to change this so it adds the totals together as it does in the my example picture?

Many thanks for your help.

Answer 1

Does it have to be a macro? you could just put in =SUMIFS(C:C,A:A,E2,B:B,F2) into G2 and fill down:

If you really want to have this in a macro, it'd be something like this:

Sub CombineAnimals()

    Range("G2").FormulaR1C1 = "=SUMIFS(C[-4],C[-6],RC[-2],C[-5],RC[-1])"
    Range("G2").AutoFill Destination:=Range("G2:G" & Range("F" & ActiveSheet.Cells.Rows.Count).End(xlUp).Row)

End Sub

Answer 2

Unless there is good reason not to, a simple SUMIFS loop should work:

Sub CombineAnimals()
With Sheets("Sheet1")
    lastRow = .Range("E" & .Rows.Count).End(xlUp).Row

    For x = 2 To lastRow
        .Cells(x, "G").Value = Application.SumIfs(.Range("C:C"), .Range("A:A"), .Cells(x, "E"), .Range("B:B"), .Cells(x, "F"))
    Next x
End With
End Sub

Answer 3

Something like this will work, although it may be a bit overkill:

You concatenate the first two cells in a string and this string is used as a key for a dictionary. Then, whenver something similar is found, you add its value to the dictionary. At the end you may print the dictionary.

Option Explicit

Public Sub TestMe()

    Dim dict            As Object
    Dim rngCell         As Range

    Dim rngInput        As Range
    Dim strInput        As String
    Dim dblInput        As Double
    Dim lngCounter      As Long
    Dim varKey          As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    Set rngInput = ActiveSheet.Range("A2:A6")


    For Each rngCell In rngInput
        strInput = rngCell.Value & rngCell.Offset(0, 1).Value
        dblInput = rngCell.Offset(0, 2).Value

        If dict.exists(strInput) Then
            dict(strInput) = dict(strInput) + dblInput
        Else
            dict.Add strInput, dblInput
        End If
    Next rngCell


    For Each varKey In dict.keys
        Debug.Print varKey, dict(varKey)
    Next varKey


End Sub