VBA: SUMPRODUCT(CountIf) Help

[Sanchrew]

Long time lurker, finally broke down and made an account (1st post).

I am in need of an if then statement in VBA. What i need it to do is count how many times each cell in Range B is in range A and does that count equal 10. the following is the formula that works in excel but not in VBA

=SUMPRODUCT(COUNTIF(RangeA,RangeB)=10

When using application.worksheetfunction in VBA i get the type mismatch error code and from my testing it seems its because VBA wants only a single criteria or cell reference in the Countif portion of the formula above.

Anyone have some alternatives that can be used instead?

Quick notes: Range A and B are made up for this example however Range A and Range B are on two difference worksheets for what its worth and both ranges are dynamic (while i know very little VBA i think i can manipulate any ideas you guys have to suit my own code).

 

[lrobbo314]

This code works on my test. You can adjust rngA and rngB as needed.

Sub test()
Dim rngA As Range: Set rngA = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim rngB As Range: Set rngB = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)

If Evaluate(Replace(Replace("SUMPRODUCT(COUNTIF(@,!))", "@", rngA.Address), "!", rngB.Address)) Then
    MsgBox "Yes"
Else
    MsgBox "No"
End If

End Sub

 

[Sanchrew]

This code works on my test. You can adjust rngA and rngB as needed.

Sub test()
Dim rngA As Range: Set rngA = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim rngB As Range: Set rngB = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)

If Evaluate(Replace(Replace("SUMPRODUCT(COUNTIF(@,!))", "@", rngA.Address), "!", rngB.Address)) Then
    MsgBox "Yes"
Else
    MsgBox "No"
End If

End Sub

Thanks for the quick reply! I was able to tweak this to get the desired results. Much appreciated friend! For the sake of learning - did you effectively trick VBA into accepting that formula using Replace whereas it normally would not have accepted the code or am I way off?

 

[lrobbo314]

No, the 'Replace' is just there to make it look a little more readable without using a bunch of '&' operators. The 'Evaluate' function is the one that makes the magic happen. Here is the code that does the same thing without 'Replace'.

Sub testII()
Dim rngA As Range: Set rngA = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim rngB As Range: Set rngB = Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)

If Evaluate("SUMPRODUCT(COUNTIF(" & rngA.Address & "," & rngB.Address & "))") >= 2 Then
    MsgBox "Yes"
Else
    MsgBox "No"
End If

End Sub