Link to home
Start Free TrialLog in
Avatar of Shino_skay
Shino_skayFlag for United States of America

asked on

VBA - Dictionary Object to count occurrences of 5 different criterias.

Hi everyone, I have a question on how to use the VBA equivalent of excel's "countif" to determine the occurences of a set of criterias. I was assisted earlier on how to use the Dictionary Object to find the unqiue "counterparties"; now, I would like to be able to count the occurences of all unique counterparties that fall in the following criterias:

1) "31-60"
2) "61-90"
3) "91-180
4)"Over 180"

Thanks everyone.
Avatar of purplepomegranite
purplepomegranite
Flag of United Kingdom of Great Britain and Northern Ireland image

It may help to start with the code already completed, which I have attached for reference.

As the data is now in a dictionary object, we are going to have to write a routine to actually do the processing - there isn't a countif equivalent that can be used exactly, but of course, we can write what we need.  I'll have a play and post some code in a bit (if no-one has got here first!)
Sub test()
Dim i As Integer
Dim dicCounterParties
Dim srcWorksheet As Worksheet
Dim strCounterParty As String
Dim intFailedDays As String
 
Set dicCounterParties = CreateObject("Scripting.Dictionary")
Set srcWorksheet = ActiveSheet
i = 1
While srcWorksheet.Cells(i, 1).Value <> ""
        strCounterParty = srcWorksheet.Cells(i, 1).Value
        intFailedDays = CInt(srcWorksheet.Cells(i, 2).Value)
        If dicCounterParties.Exists(strCounterParty) Then
                intFailedDays = intFailedDays + CInt(dicCounterParties(strCounterParty))
                dicCounterParties(strCounterParty) = intFailedDays
        Else
                dicCounterParties.Add strCounterParty, intFailedDays
        End If
        i = i + 1
Wend
End Sub

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of purplepomegranite
purplepomegranite
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Shino_skay

ASKER

Wow, purplepomegranite, thanks for writing this out. It looks quite complex to the untrained eye. It's going to take a while for me to understand every line of code and how it works. I'll start cranking at it. Have a great weekend.
While it probably does look complicated, I have broken it down into subroutines so that hopefully it will make sense when you work your way through it.  Obviously if you have any questions, feel free to ask!

You have a good weekend too... I've got a poker tournament tomorrow, so it'll definitely be a good weekend for me!
wow purple, i'm sitll have a hard time figuring out every bit of code. You threw a lot at me in 1 shot. I'm sure it'll help me in the long run but currently, its difficult to digest (and doesn't work). Quick question, what's the difference if I used the Application.WorksheetFunction.CountIf? I was thinking I can use the "proven" dictionary object to return unique values and paste it in a column. Then use the Usedrange.columns.count to determine how many rows then loop the application.worksheetfunction.countif. Just thinking rationally, I suspect this code will be a slow and inefficient for large data. sigh.. I'll give myself some more time before I resort to this. keep you updated.

I modified the  intFailedDays = intFailedDays + CInt(dicCounterParties(strCounterParty)) to CStr instead of CInt or CDbl since it produced an error. The issue now is in the Countif Function:

k = dicCounterParties.Keys is not defined and I would need to reference it somehow to the Builddictionary subroutine.


Ok, first of all... what kind of values are we adding up here?  What is the maximum total likely to be?  If you can give me an idea of range, I will modify the code.  I will also add a few comments which should help you to understand what is happening at each point.
okay, i'm close to solving this purple, dont help me yet. Forget what I said above. I realized your solution was looking at actual days failing and bucketing them while I was using a column that had buckets that had "31-60", "61-90", etc, thats why there was an error with the Test(). So once I figure out how to reference the function, then it's all good. I think better out loud, my apologies if you're annoyed.
hehe, don't worry, I'm not annoyed in the slightest.  Just let me know if you want me to change things, or are just thinking out loud ;-)
ugh, I'm a moron. You're code works beautifully (and it always did). I was only receiving an error because of the column headers. Were you ever this frustrated with VBA when you first started? I gave myself a huge headache for no reason.
hmm, I did some testing and noticed something odd about the code. If Column A had names and B had days:
Andy : 31
Bryan 61
Charlie 91
David 181

would return:

31-60: 1 matches (andy)
61-90: 1 matches (bryan)
91-180: 1 matches (charlie)
91-180: 1 matches (david)

However, if

Andy : 31
Bryan: 61
Andy: 91
Andy: 181

Summary

31-60: 0 matches ()
61-90: 0 matches()
91-180: 1 matches(andy)
91-180: 1 matches(bryan)

I just noticed the last row should be >180. I'll change that part. Purple, could you please explain how come unique values are only being counted once, with the last occurence being recorded? Thanks.
I meant

Andy : 31
Bryan: 61
Andy: 91
Bryan: 181

in the the 2nd example.
Unique variables are only added once because their existence is checked in the dictionary first (If dicCounterParties.Exists(strCounterParty)).  If a value already exists, then the existing value is read from the dictionary, and added to the entry that has just been read.  This value is then stored in the dictionary... so each time the same person is found, the total is increased.

You are right though, there is a bug in the code.  Line 20 should be:
strResults = strResults & ">180: " & CStr(intCount) & " matches (" & strMatches & ")" & vbCrLf

I obviously forgot to change that when I was copying and pasting!

And yes, when I first starting programming I was frequently frustrated.  I think most get to that point as they learn!
Thanks purprle. I'll just have to go with what I know and paste the unique names in column A, then run the application worksheet function to loop through each bracket and populate the adjacent 4 columns given its respective criteria. Maybe somewhere along the way I can think out loud a more efficient way of doing this. Thanks again! I'm going to re-enter the frustration world now.  Oh yea, I hope you did well in your poker tournament. I've been getting real unlucky in mine. Multiple eliminations when it was 3-4 way(tourney style) and I have my man dominated. Just can't win when I'm ahead :(