dcount of unique values

K

Kumar

Hi,

Is there a way where I can get a list of distinct values for a column
from a set of rows which is obtained by applying a set of filter
parameters (basically equivalent of a select distinct in SQL)?

I tried DCOUNT and it works to get the count of all values matching
the filter parameters. But I couldn't seem to find a way to get a
count of the distinct values in a column.

Please note that I need this to be done automatically, i.e., if the
data changes, this count has to change. And the data that I'm trying
to do a distinct is dynamic, i.e., it has to obtained by applying a
set of filter conditions on the actual data in the worksheet.

I'd appreciate any suggestions.

One way I could think of is write a formula which can extract a subset
of rows from ny actual data into another range of cells based on my
filter criteria. And then I can use FREQUENCY on this subset. Is there
a function/formula which could extract a subset of rows into another
range? (e.g., like SELECT in SQL.)

Thanks,
Kumar.
 
J

Jamie Collins

(e-mail address removed) (Kumar) wrote ...
Is there a way where I can get a list of distinct values for a column
from a set of rows which is obtained by applying a set of filter
parameters (basically equivalent of a select distinct in SQL)?
Is there
a function/formula which could extract a subset of rows into another
range? (e.g., like SELECT in SQL.)

Perhaps you want to use sql sytax:

Option Explicit

Sub test()
CopyToNewWorksheet "Sheet1"
End Sub

Private Function CopyToNewWorksheet( _
ByVal SheetName As String, _
Optional ByVal NewSheetName As String _
) As Boolean

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Target As Excel.Range
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strPath As String
Dim strSql1 As String
Dim lngCounter As Long

' Review the following constant:
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"

' Do NOT amend the following constants
Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH><FILENAME>;" & _
"Extended Properties='Excel 8.0;HDR=YES'"

Const SQL As String = "" & _
"SELECT DISTINCT * FROM [<SHEET_NAME>$]"

' Build connection string
strPath = ThisWorkbook.Path & _
Application.PathSeparator

strCon = CONN_STRING
strCon = Replace(strCon, _
"<PATH>", strPath)
strCon = Replace(strCon, _
"<FILENAME>", FILENAME_XL_TEMP)

' Build sql statement
strSql1 = SQL
strSql1 = Replace(strSql1, _
"<SHEET_NAME>", SheetName)

' Delete old instance of temp workbook
On Error Resume Next
Kill strPath & FILENAME_XL_TEMP
On Error GoTo 0

' Save copy of worksheet to temp workbook
Set wb = Excel.Application.Workbooks.Add()
With wb
ThisWorkbook.Worksheets(SheetName). _
Copy .Worksheets(1)

.SaveAs strPath & FILENAME_XL_TEMP
.Close
End With

' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon
.Open

Set rs = .Execute(strSql1)
End With

Set ws = ThisWorkbook.Worksheets.Add
With ws
If Len(NewSheetName) > 0 Then
.Name = NewSheetName
End If
Set Target = .Range("A1")
End With

With rs
For lngCounter = 1 To .fields.Count
Target(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next
End With

Target(2, 1).CopyFromRecordset rs

Con.Close

CopyToNewWorksheet = True

End Function


Jamie.

--
 
K

Kumar

Thanks for your help.

Kumar.

(e-mail address removed) (Kumar) wrote ...
Is there a way where I can get a list of distinct values for a column
from a set of rows which is obtained by applying a set of filter
parameters (basically equivalent of a select distinct in SQL)?
Is there
a function/formula which could extract a subset of rows into another
range? (e.g., like SELECT in SQL.)

Perhaps you want to use sql sytax:

Option Explicit

Sub test()
CopyToNewWorksheet "Sheet1"
End Sub

Private Function CopyToNewWorksheet( _
ByVal SheetName As String, _
Optional ByVal NewSheetName As String _
) As Boolean

Dim wb As Excel.Workbook
Dim ws As Excel.Worksheet
Dim Target As Excel.Range
Dim Con As Object
Dim rs As Object
Dim strCon As String
Dim strPath As String
Dim strSql1 As String
Dim lngCounter As Long

' Review the following constant:
Const FILENAME_XL_TEMP As String = "" & _
"delete_me.xls"

' Do NOT amend the following constants
Const CONN_STRING As String = "" & _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=<PATH><FILENAME>;" & _
"Extended Properties='Excel 8.0;HDR=YES'"

Const SQL As String = "" & _
"SELECT DISTINCT * FROM [<SHEET_NAME>$]"

' Build connection string
strPath = ThisWorkbook.Path & _
Application.PathSeparator

strCon = CONN_STRING
strCon = Replace(strCon, _
"<PATH>", strPath)
strCon = Replace(strCon, _
"<FILENAME>", FILENAME_XL_TEMP)

' Build sql statement
strSql1 = SQL
strSql1 = Replace(strSql1, _
"<SHEET_NAME>", SheetName)

' Delete old instance of temp workbook
On Error Resume Next
Kill strPath & FILENAME_XL_TEMP
On Error GoTo 0

' Save copy of worksheet to temp workbook
Set wb = Excel.Application.Workbooks.Add()
With wb
ThisWorkbook.Worksheets(SheetName). _
Copy .Worksheets(1)

.SaveAs strPath & FILENAME_XL_TEMP
.Close
End With

' Open connection to temp workbook
Set Con = CreateObject("ADODB.Connection")
With Con
.ConnectionString = strCon
.Open

Set rs = .Execute(strSql1)
End With

Set ws = ThisWorkbook.Worksheets.Add
With ws
If Len(NewSheetName) > 0 Then
.Name = NewSheetName
End If
Set Target = .Range("A1")
End With

With rs
For lngCounter = 1 To .fields.Count
Target(1, lngCounter).Value = _
.fields(lngCounter - 1).Name
Next
End With

Target(2, 1).CopyFromRecordset rs

Con.Close

CopyToNewWorksheet = True

End Function


Jamie.

--
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top