VB and VBA Users Source Code: Returning a distinct list of items from an Excel Range
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Returning a distinct list of items from an Excel Range
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Tuesday, November 25, 2008
Hits:
3790
Category:
VBA (Visual Basic for Applications)
Article:
Below is code to return a distinct list of items from an excel range. Option Explicit 'Purpose : Returns a list of distinct items from a range. 'Inputs : rngReturnDistinctListFrom. The range to return the distinct list from ' rngItemsAlreadyReturned. The range containing the values already returned. 'Outputs : Returns the first distinct item which has not already been returned in the rngItemsAlreadyReturned range. 'Author : Andrew Baker 'Date : 25/03/2000 'Example usuage: ' '=FirstDistinctItem(A1:A1000,B$1:B1) 'Where: 'A1:A1000 is a list containing the items to return a distinct list of 'B$1:B1 is the list containing the distinct items already returned. Function FirstDistinctItem(rngReturnDistinctListFrom As Excel.Range, rngItemsAlreadyReturned As Excel.Range, Optional bIgnoreBlanks As Boolean = True) As Variant Dim avItemsAlreadyReturned As Variant Dim vCell As Variant FirstDistinctItem = "" avItemsAlreadyReturned = rngItemsAlreadyReturned.Value For Each vCell In rngReturnDistinctListFrom If (bIgnoreBlanks = False Or (bIgnoreBlanks And vCell <> "")) = True Then If (ArrayHasItem(avItemsAlreadyReturned, vCell) = False) Then FirstDistinctItem = vCell Exit Function End If End If Next End Function 'Purpose : Checks to see if a value is already in an array. 'Inputs : avInArray. The array to evaluate. ' vValueToCheck. The value to look for in the array. 'Outputs : True. The array contains vValueToCheck ' False. The array does not contain vValueToCheck. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : The array can be any size or shape as this function Function ArrayHasItem(avInArray As Variant, vValueToCheck As Variant) As Boolean Dim vThisItem As Variant, lThisRow As Long On Error GoTo ErrExit If ArrayNumDimensions(avInArray) = 1 Then 'Faster than for each loop For lThisRow = LBound(avInArray) To UBound(avInArray) vThisItem = avInArray(lThisRow) 'Check for arrays in arrays If IsArray(vThisItem) Then 'Search an array in an array If ArrayHasItem(vThisItem, vValueToCheck) Then 'Found item ArrayHasItem = True Exit For End If ElseIf vThisItem = vValueToCheck Then ArrayHasItem = True Exit For End If Next Else For Each vThisItem In avInArray 'Check for arrays in arrays If IsArray(vThisItem) Then 'Search an array in an array If ArrayHasItem(vThisItem, vValueToCheck) Then 'Found item ArrayHasItem = True Exit For End If ElseIf vThisItem = vValueToCheck Then ArrayHasItem = True Exit For End If Next End If ErrExit: On Error GoTo 0 End Function 'Purpose : Calculates the number of dimensions in an array 'Inputs : avInArray. The array to evaluate. 'Outputs : The number of dimensions the array has. 'Author : Andrew Baker 'Date : 25/03/2000 'Notes : Function ArrayNumDimensions(avInArray As Variant) As Long Dim lNumDims As Long If IsArray(avInArray) Then On Error GoTo ExitSub Do lNumDims = UBound(avInArray, ArrayNumDimensions + 1) ArrayNumDimensions = ArrayNumDimensions + 1 Loop End If ExitSub: On Error GoTo 0 End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
