CODEWITHSUNDEEP
vbaexcel
synthaxe
synthaxe

Reputation: 95

Count number of unique values containing text

I have the following code that counts the number of cells in a column that contains the string, "ABC-QR":

Ctr = Application.WorksheetFunction.CountIf(Sheet1.Range("D4:D1500"), "*ABC-QR*")
EU.Cells(16, 3) = Ctr

I used "ABC-QR" because that's the part of the data that doesn't change. The true data that's in those cells is, for example, "ABC-QR00012345", or whatever number it may have. I would like to modify my code to not include duplicates when it's counting.

Upvotes: 2

Views: 691

Answers (2)

luke_t
luke_t

Reputation: 2985

Firstly, you must enable 'Microsoft Scripting Runtime' from within Tools --> References within the Visual Basic Editor.

You assign the data from the worksheet into an array; then import everything which fits the string criteria, and isn't a duplicate, into a dictionary. You can check for duplicates in the dictionary using the .Exists method.

EDIT: As noted by @Zev in the comments, you don't even need to use the .Exists method. You can just assign the array element to the key of the dictionary, and assign the item value as 1. Any duplicate values from the Array will overwrite the previous key, so duplicates will automatically be dealt with.

Once everything which isn't a duplicate has been imported into the dictionary, you can then use the .Count property on the dictionary. This will tell you how many records fit your string criteria, and are not duplicates, within the range passed into the array.

Option Explicit
Sub countNonDuplicates()
    Dim wb As Workbook, ws As Worksheet
    Dim dict As Scripting.Dictionary
    Dim myValues() As Variant
    Dim lRow As Long, i As Long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    Set dict = New Scripting.Dictionary
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    myValues = Range(Cells(1, 1), Cells(lRow, 1))

    For i = 1 To UBound(myValues, 1)
        If InStr(myValues(i, 1), "ABC-QR") Then dict(myValues(i,1)) = 1 'arbitrary value
    Next i
    MsgBox (dict.Count)
End Sub

The above currently gets the last row of Column A and then takes the range and assigns it to the array. If you wish to use a different column, then update the following statements with the column number required (example below now uses Column D)

lRow = Cells(Rows.Count, 4).End(xlUp).Row
myValues = Range(Cells(1, 4), Cells(lRow, 4))

Also it's currently performing the above on Sheets(1). Change the worksheet number to what you require.

On 100,000 records this took 0.2 seconds to produce the count.

Upvotes: 5

Bond
Bond

Reputation: 16321

This array formula should do the trick:

EU.Cells(16,3).FormulaArray = "=SUM(IF(ISERROR(FIND(""ABC-QR"",D4:D1500)),0,1/(COUNTIF(D4:D1500,D4:D1500))))"

Since it's an array formula, it will operate on each cell in your range in turn and look for your text (FIND("ABC-QR",D4:D1500)). If it's not found, it returns 0 to the running SUM(). If it is found, it uses the value 1/count, where count is the number of times the cell value being tested exists in your range.

Upvotes: 1

Related Questions