Mimicking an GroupBy Clause in Excel

[GreyPilgrim]

Does anyone know of an efficient way to:

Look at all of the cells in a selected column range,
identify all of the unique values in that column,
return each unique value into an array.

I think the nearest analogy I can think of is the GroupBy clause in
SQL, in Access I have a really really clunky vba routine at the moment
that basically says:

While not at the end of the list
If the current value is already in the array, don't do anything
If the current value is not in the array, add it in there
move to the next value in the list
Wend

Works fine for very small sets of data but obviously slows down for
very big data sets

Any help would be greatly appreciated!

Lee

--
GreyPilgrim
------------------------------------------------------------------------
GreyPilgrim's Profile: http://www.excelforum.com/member.php?action=getinfo&userid=31056
View this thread: http://www.excelforum.com/showthread.php?threadid=507308

[Bob Phillips]

Here is one way

Sub Macro1()
Dim iLastrow As Long
Dim ary

iLastrow = Cells(Rows.Count, "A").End(xlUp).Row
Columns("B:B").Insert
Range("B1").FormulaR1C1 = "=RC[-1]"
Range("B2").FormulaArray = _
"=IF(ISERROR(MATCH(0,COUNTIF(R1C:R[-1]C,R1C1:R" & iLastrow & _
"C1&""""),0)),""""," & Chr(10) & _
"INDEX(IF(ISBLANK(R1C1:R2000C1),"""",R1C1:R" & iLastrow & "C1)," & _
"MATCH(0,COUNTIF(R1C:R[-1]C,R1C1:R" & iLastrow & "C1&""""),0)))"
Range("B2").AutoFill Destination:=Range("B2:B" & iLastrow),
Type:=xlFillDefault
iLastrow = Evaluate("=SUMPRODUCT((A1:A" & iLastrow & "<>"""")/" & _
"COUNTIF(A1:A" & iLastrow & "," & _
"A1:A" & iLastrow & "&""""))")
ary = Range("B1:B" & iLastrow)
Columns("B:B").Delete
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"GreyPilgrim" <GreyPilgrim.22k7l...@excelforum-nospam.com>
wrote in message
news:GreyPilgrim.22k7l...@excelforum-nospam.com...

[Rajah]

Here are a couple ways to do this, Grey.

For the sake of argument, let's say that you have a "Pie of the day"
column that looks like this:
Pie of the day
Apple
Pumpkin
Apple
Banana cream
Pumpkin

You would like to get out a list:
Apple
Banana cream
Pumpkin

If you're inclined to program and you feel comfortable with ODBC, you
can treat the spreadsheet of interest as a database and use your
GroupBy clause.

An Excel-only way to perform this would be to select from the "Pie of
the day" down to the "Pumpkin." Then choose Data -> Pivot tables and
Chart report...

>From the wizard, step 1, accept the defaults. Click Next.
>From the wizard, step 2, you should already have the region selected
that you will want to use.
Click Next.
>From the wizard, step 3, accept the default of a new worksheet. Click
Next.

You'll be brought to the new worksheet with a popup ("Pivot Table Field
List"). If you drag "Pie of the day" and drop it on "Drop Row Fields
Here," you will get the unique list you're looking for.

[Tim Williams]

You might consider using the Excel driver and ADO to get your answer.
You can then actually use SQL....

Tim

--
Tim Williams
Palo Alto, CA

"GreyPilgrim" <GreyPilgrim.22k7l...@excelforum-nospam.com>
wrote in message
news:GreyPilgrim.22k7l...@excelforum-nospam.com...
>

[Tim Williams]

This might get you started. It works on the current selection, which must
be a regular 2-d table of rows/columns with a header row (which has the
"field" names).

Tim

*****************************************
Option Explicit

Sub tester()

Const S_TEMP_TABLENAME As String = "tempTable"
Const S_SQL As String = "select sdate, count(suser)" & _
"from <data> t group by sdate"

Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim sPath, icount, irow
Dim f As ADODB.Field
Dim sSQL As String
Dim sRange As String

If TypeName(Selection) <> "Range" Then
MsgBox "Must first select a range to query"
Exit Sub
Else
If Selection.Areas.Count > 1 Or Selection.Cells.Count < 2 Then
MsgBox "Must first select a continuous range to query"
Exit Sub
End If
End If

'build the "table" name
'eg: SELECT * FROM [Sheet1$E11:F23]
sRange = " [" & Selection.Parent.Name & "$" & _
Selection.Address(False, False) & "] "

sPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sPath & _
";Extended Properties='Excel 8.0;HDR=Yes'"

sSQL = Replace(S_SQL, "<data>", sRange)

'On Error Resume Next
oRS.Open sSQL, oConn

If Err.Number <> 0 Then
MsgBox "Problem: " & vbCrLf & vbCrLf & Err.Description
GoTo skip
End If

On Error GoTo 0

irow = 1

If Not oRS.EOF Then

icount = 10
For Each f In oRS.Fields
ActiveSheet.Cells(irow, icount).Value = f.Name
icount = icount + 1
Next f
irow = irow + 1

ActiveSheet.Cells(irow, 10).CopyFromRecordset oRS

Else

MsgBox "No records found"

End If

skip:
On Error Resume Next
oRS.Close
oConn.Close

End Sub

--
Tim Williams
Palo Alto, CA

"Tim Williams" <timjwilliams at gmail dot com> wrote in message
news:%23EEvEx2...@TK2MSFTNGP15.phx.gbl...