Need to Count unique items in a column with VBA

[MikeJP]

I need to count the number of unique items in a column (excluding blank cells if possible) in VBA. I want to use the number as follows:

For x = 1 to (number of unique items)

To control how many times I pass through a loop.

Thanks
Mike Piles

 

[NateO]

Okay I read you. What you have two events in the same month that both with incident the same indicent type?

There must be a way to distinguish this, yes-no?

 

[countingapples]

Yes. My data has 31 columns with data for each incident contained therein. Each incident can have multiple rows predicated on the number of personnel involved. Each incident is assigned a unique identifier called in this case the incident key. I will always be able to identify individual incidents this way. Using the function you provided I know that in this batch of data I have 400 unique incidents. This will change by month and customer, hence my need for a dynamic solution.

Does this help any?

 

[NateO]

You'll be the final judge on the helpfulness. Does the column have a header? What is it? And which column is it?

 

[countingapples]

Yes row 1 has the headers for all the columns. The incident key is in column A. The incident types are in column U. The names are: Incident Key and Incident Type.

 

[NateO]

Hello again, the following looks the key to determine the number of unique events. You'll want to change DataSheet to your sheet name and Sheets(1) to your target sheet in all instances:

<font face=Courier New><SPAN style="color:darkblue">Sub</SPAN> PtReplace()
<SPAN style="color:darkblue">Dim</SPAN> cn <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>, rs <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Object</SPAN>
<SPAN style="color:darkblue">Dim</SPAN> clcMde <SPAN style="color:darkblue">As</SPAN> <SPAN style="color:darkblue">Long</SPAN>

clcMde = Application.Calculation
Application.ScreenUpdating = <SPAN style="color:darkblue">False</SPAN>
Application.Calculation = xlCalculationManual

Sheets(1).[a2:iv65536].ClearContents

<SPAN style="color:darkblue">Set</SPAN> cn = CreateObject("ADODB.Connection")

cn.<SPAN style="color:darkblue">Open</SPAN> "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=Excel 8.0;"  <SPAN style="color:green">'Create DB connection</SPAN>
    
<SPAN style="color:darkblue">Set</SPAN> rs = CreateObject("ADODB.Recordset")
<SPAN style="color:darkblue">With</SPAN> rs
    <SPAN style="color:darkblue">Set</SPAN> .ActiveConnection = cn
    .Source = "SELECT t1.Blah, COUNT(*) <SPAN style="color:darkblue">As</SPAN> Cnt " & _
        "From (SELECT DISTINCT [Incident Key], [Incident <SPAN style="color:darkblue">Type</SPAN> Class] <SPAN style="color:darkblue">As</SPAN> Blah " & _
        "From [DataSheet$a1:iv65536]) AS T1 Group By T1.Blah"
    .<SPAN style="color:darkblue">Open</SPAN> , , 3, 3
    Sheets(1).[a2].CopyFromRecordset rs
    .<SPAN style="color:darkblue">Close</SPAN>
    
    .Source = "Select sum([Time]), sum([Number Of Personnel]) " & _
        "From [DataSheet$a1:iv65536] Group By [Incident <SPAN style="color:darkblue">Type</SPAN> Class]"
    .<SPAN style="color:darkblue">Open</SPAN> , , 3, 3
    Sheets(1).[c2].CopyFromRecordset rs
    .<SPAN style="color:darkblue">Close</SPAN>
<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">With</SPAN>
cn.<SPAN style="color:darkblue">Close</SPAN>
<SPAN style="color:darkblue">Set</SPAN> rs = Nothing: <SPAN style="color:darkblue">Set</SPAN> cn = <SPAN style="color:darkblue">Nothing</SPAN>

Application.Calculation = clcMde
Application.ScreenUpdating = <SPAN style="color:darkblue">True</SPAN>

<SPAN style="color:darkblue">End</SPAN> <SPAN style="color:darkblue">Sub</SPAN></FONT>

Put headers in row 1. It's dynamic. Just rerun it when you want a freshy.

 

[countingapples]

Ok, I'm working through this line by line.

I've received the following error:

Run-time error '-2147217904(80040e10)': No value given for one or more required parameters.

on this line:

.Source = "Select sum([Time]), sum([Number Of Personnel]) " & _
        "From [PersonnelResponseData$a1:af65536] Group By [Incident Type Class]"
    .Open , , 3, 3  ***Here***
    Sheets("Unit Response Summary").[c2].CopyFromRecordset rs
    .Close

I don't know what it is asking for. The previous instance of this line was just fine.

 

[NateO]

Hello again,

Number Of Personnel and Time are field names. They must match the correct column headers exactly.

This worked for me, could that be the problem?

Also, when this crashes on development you've got a problem in that your screen updating and calc. modes aren't reset, so be sure to check those.

Oh, make sure row 1 has continuous data in it, if you have empty cells in row 1, fill them in with a unique dummy value (until your last column versus column IV).

 

[countingapples]

Where do go do this?

Also, when this crashes on development you've got a problem in that your screen updating and calc. modes aren't reset, so be sure to check those.

I've double checked and made appropriate changes as suggested.

 

[NateO]

Just go into tools->Options to reset your calc. mode to your preferred setting.

So, how'd it all work out then?

 

[countingapples]

I now receive the following error:

Run-time error '-2147217913(80040e07)': Data type mismatch in criteria expression.

on the same line:
code:
--------------------------------------------------------------------------------

.Source = "Select sum([Hours on Call]), sum([Full Name]) " & _
"From [PersonnelResponseData$a1:af65536] Group By [Incident Type Class]"
.Open , , 3, 3 ***Here***
Sheets("Unit Response Summary").[c2].CopyFromRecordset rs
.Close
--------------------------------------------------------------------------------

Any thoughts on why it doesn't like this particular line? Is there something that I need to do differently?

Would it help if you had the whole file?