Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

VBA to count unique cells based on criteria

Posted on 2011-05-05
3
Medium Priority
?
579 Views
Last Modified: 2012-05-11
Hi, I've been using a formula to count unique, but it takes a long time to process.

There are 50 similar calculations, so I though moving it to VBA and only running it as needed might speed things up.

I have code to count unique in a column (from mrexcel.com, thread 48385), but now I would like to set that against critera from other columns.  So I want to count unique in C:C, if D:D = "x"
I'll also want to expand that to count C:C if D:D = "x" AND E:E ="y"

Could anyone help with the modifications?

Thank you
Sub CntUnique2()
Dim Uni  As Collection, cl As Range, LpRange As Range
Dim clswfrm As Range, clswcst As Range, myRng As Range
Dim TotUni As Long
'*************
Set myRng = Sheets("raw").[C:C] 'define your sheet/range
'*************
On Error Resume Next
Set clswfrm = myRng.SpecialCells(xlFormulas)
Set clswcst = myRng.SpecialCells(xlConstants)
Set myRng = Nothing 'free up memory
On Error GoTo 0
If clswfrm Is Nothing And clswcst Is Nothing Then
Exit Sub
ElseIf Not clswfrm Is Nothing And Not clswcst Is Nothing Then
Set LpRange = Union(clswcst, clswfrm)
ElseIf clswfrm Is Nothing Then Set LpRange = clswcst
Else: Set LpRange = clswfrm
End If
Set clswfrm = Nothing: Set clswcst = Nothing 'Free up memory
Set Uni = New Collection
On Error Resume Next
For Each cl In LpRange
Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
Next cl
On Error GoTo 0
Set LpRange = Nothing 'free up memory
TotUni = Uni.Count
Set Uni = Nothing ''free up memory
Application.Worksheets("report").Range("R17") = TotUni - 1 '-1 to remove the header
End Sub

Open in new window

0
Comment
Question by:TelMaco
3 Comments
 
LVL 43

Accepted Solution

by:
Saqib Husain, Syed earned 1600 total points
ID: 35699876
Change

    Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string

to

    If cl.Offset(0, 1) = "x" Then Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string

and to

    If cl.Offset(0, 1) = "x" and cl.Offset(0, 2) = "y" Then Uni.Add cl.Value, CStr(cl.Value) 'assign unique key string
0
 
LVL 18

Assisted Solution

by:krishnakrkc
krishnakrkc earned 400 total points
ID: 35699976
Hi,

Try this


Kris
Sub kTest()
    
    Dim ka, i   As Long, strConcat  As String
    
    Const Crit  As String = "x|y"
    
    With ActiveSheet
        ka = Intersect(.UsedRange, Range("c:e"))
    End With
    
    With CreateObject("scripting.dictionary")
        .comparemode = 1
        For i = 1 To UBound(ka, 1)
            strConcat = LCase$(ka(i, 2) & "|" & ka(i, 3))
            If strConcat = Crit Then
                .Item(ka(i, 1)) = Empty
            End If
        Next
        Range("g1").Value = "Unique Count"
        Range("g2").Value = .Count
    End With

End Sub

Open in new window

0
 

Author Comment

by:TelMaco
ID: 35700086
That's awesome,

Thank you both so much!

I'm going to run with ssaqibh's solution, it's fast and really simple to understand.  Also it makes it easy to apply the critera to columns that are not side by side, with the Offset part

Plus he posted it 1st ( ;

krishnakrkc I'll assign you some points too, since your suggestion works as well.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
In this fifth video of the Xpdf series, we discuss and demonstrate the PDFdetach utility, which is able to list and, more importantly, extract attachments that are embedded in PDF files. It does this via a command line interface, making it suitable …

810 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