Solved

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

Posted on 2008-06-19
14
785 Views
Last Modified: 2013-11-25
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.
0
Comment
Question by:Shino_skay
  • 8
  • 6
14 Comments
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21827027
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

0
 
LVL 24

Accepted Solution

by:
purplepomegranite earned 500 total points
ID: 21827316
The attached demonstrates how to do this.

Simply paste all the code into an Excel module - as before, it assumes the required data is on the active worksheet.  The procedure to call is "Test" (you can see there are three now).

I've put a couple of comments in to show what is going on, though admittedly not many!  Ask if you have any questions!!
Option Explicit ' Can prevent silly mistakes with variables!!
 

' Declare module level variable

Dim dicCounterParties
 

Sub Test()

   Dim strResults As String

   Dim strMatches As String

   Dim intCount As Integer

   

   BuildDictionary

   strResults = "Summary" & vbCrLf & vbCrLf

   intCount = CountIf(31, 60, strMatches)

   strResults = strResults & "31-60: " & CStr(intCount) & " matches (" & strMatches & ")" & vbCrLf

   intCount = CountIf(61, 90, strMatches)

   strResults = strResults & "61-90: " & CStr(intCount) & " matches (" & strMatches & ")" & vbCrLf

   intCount = CountIf(91, 180, strMatches)

   strResults = strResults & "91-180: " & CStr(intCount) & " matches (" & strMatches & ")" & vbCrLf

   intCount = CountIf(181, 32767, strMatches) ' In this case the maximum is the maximum possible value for an integer

   strResults = strResults & "91-180: " & CStr(intCount) & " matches (" & strMatches & ")" & vbCrLf

   MsgBox strResults, vbInformation + vbOKOnly, "Results"

End Sub
 

Sub BuildDictionary()

   Dim i As Integer

   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
 

Function CountIf(intMin As Integer, intMax As Integer, Optional ByRef strMatches As String) As Integer

   ' Counts the number of matches given the range

   ' Returns the names of the counterparties in optional variable

   Dim k

   Dim i As Integer

   Dim intCount As Integer

   

   k = dicCounterParties.Keys

   intCount = 0

   strMatches = ""

   For i = 0 To dicCounterParties.Count - 1

      If dicCounterParties(k(i)) >= intMin And dicCounterParties(k(i)) <= intMax Then

         ' This entry matches the criteria

         intCount = intCount + 1 ' Add this occurrence to the total

         If strMatches <> "" Then strMatches = strMatches & ", "

         strMatches = strMatches & k(i) ' Also make a note of the name

      End If

   Next

   CountIf = intCount ' Return the count

End Function

Open in new window

0
 

Author Comment

by:Shino_skay
ID: 21833856
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.
0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21834405
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!
0
 

Author Comment

by:Shino_skay
ID: 21857163
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.

0
 

Author Comment

by:Shino_skay
ID: 21857287
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.


0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21857417
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.
0
Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

 

Author Comment

by:Shino_skay
ID: 21857467
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.
0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21857576
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 ;-)
0
 

Author Comment

by:Shino_skay
ID: 21858418
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.
0
 

Author Comment

by:Shino_skay
ID: 21858619
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.
0
 

Author Comment

by:Shino_skay
ID: 21858630
I meant

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

in the the 2nd example.
0
 
LVL 24

Expert Comment

by:purplepomegranite
ID: 21859917
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!
0
 

Author Comment

by:Shino_skay
ID: 21860160
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 :(
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now