Function Unique(doc As notesdocument, itemname As String) As notesitem
on error goto eh
Dim i As Integer
Dim x As Integer
Dim y As Integer
Dim strarray() As String
Dim strarray2() As String
Dim tmpitem As notesitem
Set tmpitem = doc.getfirstitem(itemname)
x = Ubound(tmpitem.values)
' initialize our temporary arrays
Redim strarray(x)
Redim strarray2(x)
' populate temp arrays
x = 0
Forall v In tmpitem.values
strarray(x) = v
strarray2(x) = v
x=x+1
End Forall
' Loop through array1 for each value, with each value loop through array2 and keep count of how many times the value appears.
For x = 0 To Ubound(strarray)
itemcount = 0
For i = 0 To Ubound(strarray2)
If strarray(x) = strarray2(i) Then
itemcount = itemcount+1
End If
Next
' if there was more than one instance of this value, remove the value from the same array position in both lists
If itemcount > 1 Then
strarray(x) = ""
strarray2(x) = ""
End If
Next
y=0
'Evaluate one of the arrays to see how many values are left
For x = 0 To Ubound(strarray2)
If Not(strarray2(x)) = "" Then
y=y+1
End If
Next
x=0
' set one arrays length to the new number of remaining values
Redim Preserve strarray(y-1)
' populate the truncated array with the values from the untruncated array where there is a non-empty value.
For i = 0 To Ubound(strarray2)
If Not(strarray2(i)) = "" Then
strarray(x) = strarray2(i)
x=x+1
End If
Next
' put the values in the tmp item to pass it back
tmpitem.values = strarray
' send it on back.
Set unique = tmpitem
eh:
print "Unique Function Error: " & Cstr(Err) & " - " & Error & " with item " & itemname
End Function
(From Notes.Net - Posted 03/2001, by Jerry Carter)
_______________________________________________________________________________________
ANOTHER SOLUTION
_______________________________________________________________________________________
Dim listTemp List As String ' create the list of elements (0), (1), (4), etc, to move to final array
Dim arrayTmp() As String ' storage list for the unique array to be returned
Dim counter As Long ' counter of the number of returned values
counter=0
' verify passed variable
If Not (Isarray(incomingArray)) Then
Print "(LSUnique) Incoming array must be an array of string type."
LSUnique = incomingArray
Exit Function
End If
If Typename(incomingArray(0) ) <>"STRING" Then
Print "(LSUnique) Incoming array must be of string type."
Print "The array is type: " & Typename(incomingArray(0))
LSUnique = incomingArray
Exit Function
End If
' now the we have verified the incoming array, let's process it
Forall aentry In incomingArray
' if aentry is not yet in temporary array list we need to add it
If Not (Iselement(listTemp(aentry) )) Then
' add to list of subscripts
listTemp(aentry) = ""
counter = counter + 1
End If
End Forall
' set arraytmp list to new return array's length
Redim arrayTmp(counter-1)
' reuse counter and reset to 0 for repopulation
counter=0
' copy the list of original array's values and build the new one
Forall rentry In listTemp
arrayTmp(counter) = Listtag(rentry)
counter = counter + 1
End Forall
' return the built array
LSUnique= arrayTmp
previous page
|