Countif formula in excel VBA

[Niraj Baraili]

Hi Experts,

I have a large data set where i have to use countif function to take count how many times the number is repeated. I have attached a demo file for better understanding. I have two columns A and B, where in Col A i have repeated numbers and in column B i need to take to find out how many times the number is repeating.I tried using countif function but it's taking lot of time. Then i found the below code in internet, but not sure how to make changes as per my requirement.(Pivot table approach is not preferable)

Sub sbADOExample()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
DBPath = ThisWorkbook.FullName
'You can provide the full path of your external file as shown below
'DBPath ="C:\InputData.xlsx"
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
Conn.Open sconnect
sSQLSting = "SELECT * From [Test$]" ' Your SQL Statement (Table Name= Sheet Name=[Sheet1$])
mrs.Open sSQLSting, Conn
'=>Load the Data into an array
'ReturnArray = mrs.GetRows
''OR''
'=>Paste the data into a sheet
Sheet2.Range("A2").CopyFromRecordset mrs
'Close Recordset
mrs.Close
'Close Connection
Conn.Close
End Sub

Any help on this is greatly appreciated.

 

[Niraj Baraili]

Sorry. Missed the file.

 

[shrivallabha]

Not sure about above method. See if below code helps your case.

Public Sub GetCounts()
Dim varRng As Variant
Dim objDict As Object
'\\ Build a 2D Array
varRng = Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value
Set objDict = CreateObject("Scripting.Dictionary")
With objDict
    '\\ First Pass to build count
    For i = LBound(varRng) To UBound(varRng)
        If .exists(varRng(i, 1)) Then
            .Item(varRng(i, 1)) = .Item(varRng(i, 1)) + 1
        Else
            .Add varRng(i, 1), 1
        End If
    Next i
    '\\ Second Pass to load counts in 2nd column
    For i = LBound(varRng) To UBound(varRng)
        varRng(i, 2) = .Item(varRng(i, 1))
    Next i
End With
'\\ Load back results to the sheet
Range("A2:B" & Range("A" & Rows.Count).End(xlUp).Row).Value = varRng
End Sub

 

[Niraj Baraili]

Hi Shrivallabha,

Thanks for the solution. It's working absolutely fine.

But i am confussed on CreateObject("Scripting.Dictionary"). Could you please put some light how exactly it works ?

 

[shrivallabha]

Dictionary is collection object which functions like associative array is part of "Microsoft Scripting Runtime" library (the same which also holds FileSystemObject). It has several useful methods and in cases like above can give good speed.

If you set the reference to above library then you can then early bind it like below:

Dim objDict as Dictionary

This will allow you to see various methods while writing the code.

There are several write-ups on it. Please go through one of them to gain understanding.
http://www.snb-vba.eu/VBA_Dictionary_en.html

In our case,
> We load the contents in an array to do processing in memory (which normally yields faster results)
> Then in standard For...Next construct we check if a Key exists where Key is the value in Column A using .Exists method.
>> If the Key exists we add 1 to count
>> If the Key doesn't exist then we add it dictionary with count 1.
> End of the For Loop means we already have Unique Keys and their associated count.
> In the second pass, we loop through the same array and using Key we retrieve item where we have stored associated count.
> At the end of second pass, we just assign data back to the Range.

So we deal with Range object only at the beginning and end only. During rest of the processing we do it in memory.

 

[Niraj Baraili]

Thanks Sir.

Surely, i will go through the link and try to understand this concept.