Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Unique
Sub GetNamesinArray() Dim B() Dim ListOfNames() As String Dim FS As FileSearch Set FS = Application.FileSearch FS.FileType = msoFileTypeExcelWorkbooks FS.LookIn = Range("A1").Value FS.SearchSubFolders = True FS.Execute For i = 1 To FS.FoundFiles.Count ReDim Preserve ListOfNames(1 To i) If Right(FS.FoundFiles(i), 3) = "xls" Then Fname1 = Split(FS.FoundFiles(i), "_") Fname2 = Fname1(UBound(Fname1)) Fname = Mid(Fname2, 1, Len(Fname2) - 4) Else Fname = Fname2 End If ListOfNames(i) = Fname Next i B() = UniqueItems(ListOfNames, False) For i = 1 To UBound(B) Cells(i + 1, 1).Value = B(i) Next i End Sub Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant ' Accepts an array or range as input ' If Count = True or is missing, the function returns the number ' of unique elements ' If Count = False, the function returns a variant array of unique ' elements Dim Unique() As Variant ' array that holds the unique items Dim Element As Variant Dim i As Integer Dim FoundMatch As Boolean ' If 2nd argument is missing, assign default value If IsMissing(Count) Then Count = True ' Counter for number of unique elements NumUnique = 0 ' Loop thru the input array For Each Element In ArrayIn FoundMatch = False ' Has item been added yet? For i = 1 To NumUnique If Element = Unique(i) Then FoundMatch = True GoTo AddItem '(Exit For-Next loop) End If Next i AddItem: ' If not in list, add the item to unique list If Not FoundMatch Then NumUnique = NumUnique + 1 ReDim Preserve Unique(NumUnique) Unique(NumUnique) = Element End If Next Element ' Assign a value to the function If Count Then UniqueItems = NumUnique Else UniqueItems = Unique End Function |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Filer for unique records and return all column data for unique rec | Excel Discussion (Misc queries) | |||
How to pick out unique components in a list with unique and common | Excel Discussion (Misc queries) | |||
Attempting to sort unique/only count first record in each unique g | Excel Discussion (Misc queries) | |||
unique filter results in some non-unique records. | Excel Discussion (Misc queries) | |||
Formulas for...1. Counting unique cells 2. Display unique contents | Excel Programming |