@Unique LotusScript Equivalent Function

Mindwatering Incorporated

Author: Tripp W Black

Created: 10/02/2003 at 03:46 PM

 

Category:
Notes Developer Tips
LotusScript

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