List the UNIQUE certain fields from the database

[Andri]

Dear Experts,

Please help related to the above subject.
From this discussion, got the following formula which is work well and
faster for small of database
=OFFSET($G$1,MATCH(0,MMULT(--TRANSPOSE(TRANSPOSE(DATA)=I$1:I1),ROW(INDIRECT("1:"&ROW()-1))/ROW(INDIRECT("1:"&ROW()-1))),0)-1,0,1,1)
where $G$1, the first row of DATA.

how to convert it to VBA as this time i have a huge database.

for Tab Data, Advanced, Unique Record only (works well also, but i need the
VBA).

basically we would like to do similar like this:
Data Sample

Vendor Name
A
B
F
B
C
E
E
E
A

the Result of Unique Vendor will be
A
B
F
C
E

TIA

 

[Per Jessen]

Hi

Using VBA I would use an advanced filter and filter for unique entries, and
copy the result to another cell place.

Use the macro recorder to get started, and post the recorded macro in the
Programming group for further help.

Hopes this helps.
....
Per

 

[Mike H]

Andri,

Try this code

Sub stance()
Dim MyRange As Range
Set sht = Sheets("Sheet1") ' Change to suit
Dim x As Long, LastRow As Long
x = 1
LastRow = sht.Cells(Cells.Rows.Count, "G").End(xlUp).Row
Set MyRange = sht.Range("G1:G" & LastRow)
For Each c In MyRange
If WorksheetFunction.CountIf(sht.Range("H1:H" & x), c.Value) = 0 Then
sht.Range("H" & x + 1) = c.Value
x = x + 1
End If
Next
End Sub
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.

 

[Andri]

Dear Mike,

thank you for your excellent VBA and Quotes.

the code has fulfil the requirement.

have a nice weekend to all of you.

respectfully,
andri

 

[Bernd P]

Hello Andri,

If speed is an issue I suggest to take my UDF Lfreq2:
http://sulprobil.com/html/lfreq.html

Regards,
Bernd

 

[Dana DeLouis]

Hi. Just some more options.
There are many variations, even along the following general ideas.
Assuming A1 is a database heading, this gets data starting in A2, and
places unique data in C2.


Sub YourMainCode()
Dim Unique
Unique = Union(GetColumn([A2]).Value)
[C2].Resize(UBound(Unique)) = T1(Unique)
End Sub

'// Library Stuff:

Function Union(v)
'// UnSorted Union
Dim D, Obj
Const Dummy As Long = 1

Set D = CreateObject("Scripting.Dictionary")

On Error Resume Next
For Each Obj In v
D.Add Obj, Dummy
Next Obj

'Note: Moving Keys out makes Index 0-based
'I prefer 1-base. Adjust other code if not used
Union = T2(D.keys)
End Function

Function GetColumn(Top) As Range
Set GetColumn = Range(Top, Cells(Rows.Count, Top.Column).End(xlUp))
End Function

Function T1(m)
'Transpose Once
T1 = WorksheetFunction.Transpose(m)
End Function

Function T2(m)
'Transpose twice
With WorksheetFunction
T2 = .Transpose(.Transpose(m))
End With
End Function


= = = = = = =
HTH :>)
Dana DeLouis