Excel VBA If Then Loop conditions

Question

I've been struggling with this for a few days. Any help would greatly be appreciated!

It's difficult to explain, so I'll do my best.

What I'm trying to do is count the number of results each query has and then categorize them based on that result count.

For example if Query_A has 1 exact result and then Query_Z has 1 exact result then that would be a total of 2 queries that have 1 result.

I'm currently trying to use Loop with if then statements, but I'm at a loss.

Here is some example data and the output I was hoping for: Query_Example_Data_and_Results.xlsx - This is not my real spreadsheet as it is thousands of rows of data and a very large file size.

The code below does pull the query count (removing the query dupes), but does not give the query result count.. I would have provide my code attempts, but I know I'm not even close... So I have removed my failed attempts hoping I'm being clear enough to get steered in the right direction.

Sub Query_Count()

G_40 = 0

Query = ""

Application.StatusBar = " ~~ ~~ QUERY COUNT ~~ RUNNING ~~ ~~ " & x

x = 2

Do Until Sheets(1).Cells(x, 1) = ""

    If Sheets(1).Cells(x, 9) = "Yes" Then
    If Query <> Sheets(1).Cells(x, 1) Then
        G_40 = G_40 + 1
    End If
    End If
    Query = Sheets(1).Cells(x, 1)

x = x + 1

Loop

Application.StatusBar = "DONE RUNNING QUERY COUNT OF " & x & " ROWS!"

G = 40
Sheets(3).Cells(G, 7) = G_40 'query_count:

End Sub

Thank you in advance!

Solution

Based on your Example this code will do the job:

Option Explicit

Sub getResults()
    Application.ScreenUpdating = False

    Dim ws1 As Worksheet, ws2 As Worksheet, lr&
        Set ws1 = ThisWorkbook.Sheets("Example_Query_Data")
        Set ws2 = ThisWorkbook.Sheets("Example_Results")
        lr = ws1.Range("A" & Rows.count).End(xlUp).Row

    Dim arr() As String, i&, j&, cnt&
    Dim varr() As String
    cnt = 0

    ReDim arr(lr - 2)
    For i = 2 To lr
        arr(i - 2) = CStr(ws1.Range("A" & i).Value) ' fill array
    Next i
    Call RemoveDuplicate(arr) 'remove duplicate
    ReDim varr(0 To UBound(arr), 0 To 1)
    For i = LBound(arr) To UBound(arr)
        varr(i, 0) = arr(i)
        varr(i, 1) = getCount(arr(i), ws1, j, lr)
    Next i

    Call PrepTable(ws2)
    Call UpdateTable(ws2, ws1, varr, j, lr) ' Update table

    Application.ScreenUpdating = True
End Sub

Function getCount(qName$, ByRef ws1 As Worksheet, ByRef i&, lr&)
    Dim count&
    count = 0
    For i = 2 To lr
        If (StrComp(CStr(ws1.Range("A" & i).Value), qName, vbTextCompare) = 0) And _
              (StrComp(CStr(ws1.Range("C" & i).Value), "Yes", vbTextCompare) = 0) Then count = count + 1
    Next i
    getCount = count ' return count
End Function

Sub UpdateTable(ByRef ws As Worksheet, ByRef ws2, ByRef arr() As String, ByRef i&, lr&)
    Dim tblIter&
    For tblIter = 2 To 12
        For i = LBound(arr) To UBound(arr)
            If arr(i, 1) = tblIter - 1 Then
                ws.Range("B" & tblIter).Value = ws.Range("B" & tblIter).Value + 1
            End If
        Next i
    Next tblIter
    Call ElevenAndMore(ws, ws2, arr, lr, i)
End Sub

Sub PrepTable(ws As Worksheet)
    ws.Range("B2:B12").ClearContents
End Sub

Sub ElevenAndMore(ByRef ws As Worksheet, ByRef ws2, ByRef arr() As String, lr&, ByRef i)
    Dim cnt&, j&
    cnt = 0
    For i = LBound(arr) To UBound(arr)
     For j = 1 To lr
        If StrComp(CStr(ws2.Range("A" & j).Value), arr(i, 0), vbTextCompare) = 0 Then
            cnt = cnt + 1
        End If
     Next j
     If cnt > 10 Then ws.Range("B12").Value = ws.Range("B12").Value + 1
     cnt = 0
    Next i
End Sub

Sub RemoveDuplicate(ByRef StringArray() As String)
    Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String
    If (Not StringArray) = True Then Exit Sub ' is empty?
    lowBound = LBound(StringArray)
    UpBound = UBound(StringArray)
    ReDim tempArray(lowBound To UpBound)
    cur = lowBound ' first item
    tempArray(cur) = StringArray(lowBound)
    For A = lowBound + 1 To UpBound
        For B = lowBound To cur
            If LenB(tempArray(B)) = LenB(StringArray(A)) Then
                If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For
            End If
        Next B
        If B > cur Then cur = B: tempArray(cur) = StringArray(A)
    Next A
    ReDim Preserve tempArray(lowBound To cur) ' reSize
    StringArray = tempArray ' copy
End Sub

Post-Comment Edit: Change these three:

Add +28 to the tblIter

Sub UpdateTable(ByRef ws As Worksheet, ByRef ws2, ByRef arr() As String, ByRef i&, lr&)
    Dim tblIter&
    For tblIter = 2 To 12
        For i = LBound(arr) To UBound(arr)
            If arr(i, 1) = tblIter - 1 Then
                ws.Range("B" & tblIter + 28).Value = ws.Range("B" & tblIter + 28).Value + 1
            End If
        Next i
    Next tblIter
    Call ElevenAndMore(ws, ws2, arr, lr, i)
End Sub

Simply change location to B40

Sub ElevenAndMore(ByRef ws As Worksheet, ByRef ws2, ByRef arr() As String, lr&, ByRef i)
    Dim cnt&, j&
    cnt = 0
    For i = LBound(arr) To UBound(arr)
     For j = 1 To lr
        If StrComp(CStr(ws2.Range("A" & j).Value), arr(i, 0), vbTextCompare) = 0 Then
            cnt = cnt + 1
        End If
     Next j
     If cnt > 10 Then ws.Range("B40").Value = ws.Range("B40").Value + 1
     cnt = 0
    Next i
End Sub

And prep table change range

Sub PrepTable(ws As Worksheet)
    ws.Range("B30:B40").ClearContents
End Sub

and this should do!

Comments

[Siddharth Rout]

I am slightly confused. I understand Q1 and Q2 being 1 and 0 resp but how is Q3, 1 or Q4, 1?

[CodeCore]

Q3 has 3 results, so that's then 1 time a query has 3 results. If another Query comes along with 3 results as well, then the total number of queries with 3 results would now be 2. Hope that helps.

[CodeCore]

Wow! This is awesome.. Thank you soo much!! I have much to learn.. I do have a question: The 11+ (11 or more) data isn't being counted. Only when it's exactly 11.. I'm trying to solve this as well.. but really out of my comfort zone with just understanding the code created.. I really appreciate yours or anyone elses help here!! If it helps - the 11+ would be a max 20 queries.. So the logic could be queries with 11-20 result count. Thanks again!!

[Admin]

I have modified the code, run again please see if theres anything else i missed. ( added PrepTable sub, and ElevenAndMore )

[CodeCore]

You are awesome!! Thank you soo much!!

[CodeCore]

OK - now I know I'm being a pain.. but can't figure it out.. In my spreadsheet I need the data to output B30-B40 - I changed 11+ as I changed the value.. but I'm lost on how you're defining the row to output to for B30-B39. I'm sorry I wish I knew this better.. Thank you for your help!

[Admin]

you can change the UpdateTable sub, or record yourself a macro that will run at the end of the getResults() and simply move your table to whatever location you want. If you decide to change UpdateTable as you can see I am matching against table (iterator-1) which is the index(row) in your table. the easier way its to modify that with case or if - elseif statements, so if the count of queries = 1 write to b-30, if 2-b31 and so on

[Admin]

now that we know there are no more than 20 queries - for better efficiency you can change the size of the array created for counting how many queries there are from lastRow to 20.

[CodeCore]

Ok - this is wonderful - I've been playing with data and everything seems great. Thank you!!