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

asked on

VBA - Dictionary Object to identify Unique Values then count occurences given a set bucket of criterias

Hi, I'm still new to VBA  and I have to use VBA to determine of a weekly list, the top 20 unique counterparties failing for trades over 30 days.

I read the Dictionary object is the most efficient but I'm having difficulties finding an example to learn from. If the counterparty names are in column "A" and failed days are in B, how could I use the dictionary object to form a list of total unique counterparties then count the occurrences given if the days failng >30. Your help is much appreciated. I read it involves .add then .exist and then looping it. A template would be awesome. In addition, should I use early binding or late binding for this code? Thanks everyone.
Avatar of purplepomegranite
purplepomegranite
Flag of United Kingdom of Great Britain and Northern Ireland image

The below is an example of how the dictionary object is used.  It will add the counter parties, and if there is already an entry it will add the failed days to the existing value.  I haven't included a check for >30 days.

You can use early or late binding, it doesn't really matter.  To use early binding you will need to add a reference to the Scripting Runtime library in Excel though, which you don't need to do with late binding (which I have used here).
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=srcWorkSheet.Cells(i,2).Value
	if dicCounterParties.Exists(strCounterParties) then
		intFailedDays=intFailedDays+dicCounterParties(strCounterParties)
		dicCounterParties(strCounterParties)=intFailedDays
	else
		dicCounterParties.Add strCounterParty, intFailedDays
	end if
	i=i+1
wend

Open in new window

Avatar of Shino_skay

ASKER

Thanks for your reply, I tried applying the script above and I received an runtime error '457, This key is already associated with an element of this collection (which I assume is the 1st duplicate value found). Could you please advise on how to work around that? Thanks again.
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
Thanks, I'll give this a shot. Appreciate your help in writing the template.
Uch... sorry, there were more typos in the code.  My fault for not using option explicit really.  Attached code is correct, honest!  Code above would have added the first item, but failed to add up the total.
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 = srcWorksheet.Cells(i, 2).Value
        If dicCounterParties.Exists(strCounterParty) Then
                intFailedDays = intFailedDays + dicCounterParties(strCounterParty)
                dicCounterParties(strCounterParty) = intFailedDays
        Else
                dicCounterParties.Add strCounterParty, intFailedDays
        End If
        i = i + 1
Wend
End Sub

Open in new window

haha, its alright, I didn't catch the error yet. Still trying to decipher each step since I'm a newb to vba. Appreciate your help in fixing the error or I would have started pulling some hair out.
Hi purplepomegranite, I have a quesiton about the add portion of the script. It seems like for the days failing, the value is concatenated. If you dont mind answering, how may I

a) sum the total values of each unique counterparty?
b) use a vba "countif" that determines the occurence of a criteria such as "USD"?

Again, your help is much appreciated. I'm excited that your above formula works wonders. Thanks in advance!
wait, I think i'm and idiot. For:

A) I think the answer is to use some sort of Application.Sum on the intF
                intFailedDays = intFailedDays + dicCounterParties(strCounterParty)
B) I think the answer is to use

 If dicCounterParties.Exists(strCounterParty) and dicCounteParties.Exist(criteria) Then

Am I on the right trail purplepomegranite?
By concatenating, you mean that the occurences are being added as if they were a string?  Looking at the code, this is possible, due to VBS making presumptions... The attached will address that issue by explicitly converting the relevant values to integer.

To check for particular values/items, you would need to write another loop after the dictionary object has been populated.  This could check for anything you like.  It can be done without too much difficulty, but this warrants posting another question.
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

I'll post another question in regards to the critera. Sticking to this question, Could you please elaborate on why "CInt" was used on the counterparty string?

"CInt(dicCounterParties(strCounterParty)"?

I switched it and used it as the following and received the same (correct) output.

                intFailedDays = CInt (intFailedDays) + dicCounterParties(strCounterParty)
It was used on dicCounterParties(strCounterParty) because this is what VB would have been reading as the string.  However, as I also changed the code earlier to force intFailedDays to be an integer, it doesn't make a lot of difference on this line anymore - so long as one of the values is an integer, vbscript will try to treat both as that.

CInt(intFailedDays) actually does nothing - intFailedDays is already an integer.  You can probably drop the CInt altogether on that line now and it will still work properly.
wow, Thanks purplepomegranite. Your knowledge is impressive. Which books helped you get started? I have "Excel 2003 Power Programming with VBA 2003", I didn't think it was that great. I just ordered "VB & VBA in  Nutshell: The Languages". I'm hoping it would help me get over the hump.

In addition, I posted a new question for the one I stated above.
I haven't actually read any books on it...

I started with a ZX81 when I was small (about 8), and then progressed to an Acorn Electron!!  I learned basic then assembly language on that and could pretty much drive it to it's limits (which were very small compared to today's computers!).

I got back into VB when I got a job with Vodafone crunching stats at their call-centre.  I had to interface between their telephone system and the intranet, crunching all the data in between to make nice graphs that the management could look at and say "Oh, that's pretty", without really understanding what they meant anyway...

Once you have an understanding of programming concepts and VB, the best reference library is MSDN, or the VBA library in Office.  It is pretty much all I use now - that and the internet for code snippets!  One of the best ways to learn is to see code and work your way through it, experimenting (like you were with the CInt).
Hey PurplePomegranite, the code works fine under a small test range (20). I tried using it on the actual reference sheet and received a "run-time error 6, overflow. I'm using excel 2002 and there are 450 rows so far (may flucuate to 800 on certain weeks).  
Overflow will be the count getting to large for an integer (i.e. > 32000 or so?).  I have changed the variable to a long, see attached code.  That should sort it.

Note that the declaration will also need to be changed in the modified code in the other question too.  I'll have a look at that too.
Sub test()
Dim i As Integer
Dim dicCounterParties
Dim srcWorksheet As Worksheet
Dim strCounterParty As String
Dim lngFailedDays As Long
 
Set dicCounterParties = CreateObject("Scripting.Dictionary")
Set srcWorksheet = ActiveSheet
i = 1
While srcWorksheet.Cells(i, 1).Value <> ""
        strCounterParty = srcWorksheet.Cells(i, 1).Value
        lngFailedDays = CLng(srcWorksheet.Cells(i, 2).Value)
        If dicCounterParties.Exists(strCounterParty) Then
                lngFailedDays = lngFailedDays + CLng(dicCounterParties(strCounterParty))
                dicCounterParties(strCounterParty) = lngFailedDays
        Else
                dicCounterParties.Add strCounterParty, lngFailedDays 
        End If
        i = i + 1
Wend
End Sub

Open in new window

I see what you're saying. I actually used the amount of shares traded (eg. 1,000,000,000) and therefore, is out of the range of the 'integer', therefore dimensioning it as "long" would work. I see you also used CLng (srcWorksheet.Cells(i, 2).  Great tip Purple. now I know what the error 6 means. Man, I don't know to say, but thanks for being so patient and helpful.
No problem!  Actually, I noticed a bug in the previous code which was why the conversion needed to be done anyway... I'd got confused between VBA and VBScript, as I answer questions on both regularly and am always swapping between them!  I'd declared the variable as a string, not a number - hence it was being treated as a string - you can see I've changed the dim statement in the above code accordingly.
actually, I needed to you "double" since the trade size is enormous. woohoo, I'm getting it (somewhat). now to tackle that other template you written for me.