On Nov 6, 4:47*pm, euroride7 wrote:
Can somebody please tell me how to write the VBA code for this. Thank
you.

The following is a security log indicating a bunch of differents
events that occured (sample data). The actual list is much longer. *I
have 4 workseets corresponding to 4 different computer logs.

Event ID * * * *Category
529 * * Logon/Logoff
537 * * Logon/Logoff
681 * * Account Logon
565 * * Directory Service Access
627 * * Account Management
677 * * Account Logon

I need to create a macro that counts how many times each Event ID
occured and put it in a new column "Instances" to look like below.
Please help.

Event ID * * * *Category * * * * * * * * * * * * * * * * *Instances
529 * * Logon/Logoff * * * * * * * * * * *4
537 * * Logon/Logoff * * * * * * * * * * 78
539 * * Logon/Logoff * * * * * * * * * * 17
565 * * Directory Service Access * * * *590
577 * * Privilege Use * * * * * * * * * *1
627 * * Account Management * * * 1
675 * * Account Logon * * * * * * * * *1852
676 * * Account Logon * * * * * * * * *90
677 * * Account Logon * * * * * * * * *121
681 * * Account Logon * * * * * * * * *41

This is code I provided for another current post (Count Uniques in
Column G Until Change in Column C, then Restart C), but it gives you
the basic idea....

Try this:

Private Sub Test()
'Scripting.Dictionaries require reference to MS Scripting Runtime
Dim dicNames As Scripting.Dictionary
Dim dicIDs As Scripting.Dictionary
'Input ranges
Dim rNames As Excel.Range
Dim rIDs As Excel.Range
'Counter
Dim lCtr As Long
'Value in Name column
Dim sName As String
'Value in ID Column
Dim vID As Variant

'These will be different for you
Set rNames = Sheets(1).Range("A1:A8")
Set rIDs = Sheets(1).Range("B1:B8")

'Initialize Name dictionary
Set dicNames = New Scripting.Dictionary
'Loop through cells in ranges (This can be done quicker if
necessary)
For lCtr = 1 To rNames.Rows.Count
'Get name and ID
sName = rNames(lCtr, 1).Value
vID = rIDs(lCtr, 1).Value

'See if name exists in Name dictionary
If dicNames.Exists(sName) Then
'If yes set IDs dictionary = to it's value
Set dicIDs = dicNames(sName)
Else
'If not, create a new dictionary
Set dicIDs = New Scripting.Dictionary
End If
'Add ID to IDs dictionary
'Doing it like this instead of using .Add will eliminate Dupe
IDs for same name
dicIDs(vID) = vID
'Store dicIDs in dicNames
Set dicNames(sName) = dicIDs
Next

'Get count of ID's for each Name
For lCtr = 0 To dicNames.Count - 1
Set dicIDs = dicNames.Items(lCtr)
'This will be different for you
MsgBox "Name: " & dicNames.Keys(lCtr) & " , Count: " &
dicIDs.Count
Next
End Sub