How to loop over conditions in countifs formula VBA - excel

Question

I have an Excel worksheet with a column full of COUNTIFS() formulas. For each one that evaluates to zero, I have to manually apply filters on the appropriate columns to find out at which step in the formula the result reached zero. What I want to do is write a macro to automate this a bit. For instance:
=COUNTIFS('Data'!A:A,"Yes",'Data'!B:B,"Yes",'Data'!C:C,"Yes")
If the count becomes zero as soon as the first condition is evaluated, I want it to MsgBox a value of 1. If it becomes zero upon evaluating the second condition, return a 2 instead. If it doesn't hit zero until adding the third condition, I want it to return a 3 instead, and so on.
For the sake of simplicity, assume it only has to work for one cell, rather than looping through each cell in my column.
EDIT: Here is the code I've written so far. It will take a COUNTIFS() formula and run the first condition as a COUNTIF(), but I haven't been able to think of how to extend this to also do the later conditions.
'Find Indexes
countifsStart = InStr(1, cell.Formula, "COUNTIFS(")
sheetNameStart = InStr(countifsStart, cell.Formula, "(") + 2
sheetNameEnd = InStr(sheetNameStart, cell.Formula, "'")
searchRangeStart = InStr(sheetNameEnd, cell.Formula, "!") + 1
searchRangeSemicolon = InStr(searchRangeStart, cell.Formula, ":")
searchStringStart = InStr(searchRangeSemicolon, cell.Formula, ",") + 2
searchStringEnd = InStr(searchStringStart, cell.Formula, ",") - 1
'Parse formula components
sheetName = Mid(cell.Formula, sheetNameStart, sheetNameEnd - sheetNameStart)
searchColumn = Mid(cell.Formula, searchRangeStart, 1)
Set searchRange = Range(searchColumn & ":" & searchColumn)
searchString = Mid(cell.Formula, searchStringStart, searchStringEnd - searchStringStart)
'Run the countif
countIf = Application.WorksheetFunction.countIf(Sheets(sheetName).Range(searchColumn & ":" & searchColumn), searchString)
'Point out the culprit
MsgBox "Sheet Name: " & sheetName & vbNewLine & _
"Search Range: " & searchColumn & ":" & searchColumn & vbNewLine & _
"Search String: " & searchString & vbNewLine & _
"CountIf: " & countIf

Answer 1

Perhaps something like this will work for you:
Sub tgr()
Dim rFormula As Range
Dim hArguments As Object
Dim sArguments As String
Dim sMessage As String
Dim sTemp As String
Dim sChar As String
Dim lFunctionStart As Long
Dim lParensPairs As Long
Dim lQuotePairs As Long
Dim bArgumentEnd As Boolean
Dim i As Long, j As Long
Set hArguments = CreateObject("Scripting.Dictionary")
For Each rFormula In Selection.Cells
lFunctionStart = InStr(1, rFormula.Formula, "COUNTIFS(", vbTextCompare)
If lFunctionStart > 0 Then
lFunctionStart = lFunctionStart + 9
lParensPairs = 1
lQuotePairs = 0
j = 0
bArgumentEnd = False
For i = lFunctionStart To Len(rFormula.Formula)
sChar = Mid(rFormula.Formula, i, 1)
Select Case sChar
Case "'", """"
If lQuotePairs = 0 Then
lQuotePairs = lQuotePairs + 1
Else
lQuotePairs = lQuotePairs - 1
End If
sTemp = sTemp & sChar
Case "("
If lQuotePairs = 0 Then
lParensPairs = lParensPairs + 1
End If
sTemp = sTemp & sChar
Case ")"
If lQuotePairs = 0 Then
lParensPairs = lParensPairs - 1
If lParensPairs = 0 Then
j = j + 1
hArguments(j) = sTemp
sTemp = vbNullString
Exit For
Else
sTemp = sTemp & sChar
End If
Else
sTemp = sTemp & sChar
End If
Case ","
If lQuotePairs = 0 And lParensPairs = 1 Then
bArgumentEnd = True
j = j + 1
hArguments(j) = sTemp
sTemp = vbNullString
Else
sTemp = sTemp & sChar
End If
Case Else
sTemp = sTemp & sChar
End Select
Next i
For i = 1 To hArguments.Count Step 2
If Len(sArguments) = 0 Then
sArguments = hArguments(i) & "," & hArguments(i + 1)
Else
sArguments = sArguments & "," & hArguments(i) & "," & hArguments(i + 1)
End If
If Evaluate("COUNTIFS(" & sArguments & ")") = 0 Then
MsgBox "Search Range: " & hArguments(i) & Chr(10) & _
"Search String: " & hArguments(i + 1) & Chr(10) & _
"Countif condition position: " & Int(i / 2) + 1
Exit For
End If
Next i
End If
Next rFormula
End Sub

Answer 2

Posting just as an alternative method to get at the arguments (which I found in another answer elsewhere by Peter Thornton)
Private args()
Sub Tester()
Debug.Print GetZeroStep(Range("M1"))
End Sub
Function GetZeroStep(c As Range)
Dim f, arr, i, r, s, n, rng, v
f = Replace(c.Formula, "=COUNTIFS(", "=MyUDFTmp(")
Debug.Print f
r = Application.Evaluate(f)
For i = 0 To UBound(args) Step 2
n = n + 1
Set rng = args(i)
v = args(i + 1)
If Not IsNumeric(v) Then v = """" & v & """"
s = s & IIf(s <> "", ",", "") & "'" & rng.Parent.Name & "'!" & _
rng.Address() & "," & v
Debug.Print "=COUNTIFS(" & s & ")"
r = Application.Evaluate("=COUNTIFS(" & s & ")")
If r = 0 Then
GetZeroStep = n
Exit Function
End If
Next i
GetZeroStep = 0 '<< didn't return zero on any step...
End Function
'https://social.msdn.microsoft.com/Forums/Lync/en-US/8c52aee1-5168-4909-9c6a-9ea790c2baca/get-formula-arguments-in-vba?forum=exceldev
Public Function MyUDFTmp(ParamArray arr())
args() = arr
End Function