How to create a function?

[leungkong]

I use below code to store the unique record in a array - sUCells()
and count the number of element of the array - iUVals

Since I use this code more than one time in my template.
To easy reading and maintain.
Can I set a function to return two objtct "sUCells() & iUVals" ?
Any suggest? Thanks.

Dim myrange As Range
Dim cell As Range
Dim j As Integer
Dim iNumCells As Integer
Dim iUVals As Integer
Dim sUCells() As String
Dim lastrow As Integer
lastrow = Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row

Set myrange = Range("A2:A" & lastrow)
iNumCells = myrange.Count
ReDim sUCells(iNumCells) As String

iUVals = 0
For Each cell In myrange
If cell.Text > "" Then
For j = 1 To iUVals
If sUCells(j) = UCase(cell.Text) Then
Exit For
End If
Next j
If j > iUVals Then
iUVals = iUVals + 1
sUCells(iUVals) = UCase(cell.Text)
End If
End If
Next cell
Set myrange = Nothing
Set cell = Nothing
If iUVals = 0 Then Exit Sub

For i = 1 To iUVals
...
Next i

 

[Shasur]

Hi

You can try passing the variable by reference as shown below

Sub Call_Function()

Dim MyRange As Range
Dim MyVal As Long

Function_Two_Return_Example MyRange, MyVal

MsgBox MyVal
MsgBox MyRange.Address

End Sub

Function Function_Two_Return_Example(ByRef aRange As Range, ByRef iVal As
Long)

Set aRange = Range("A2:A6")
iVal = 10

End Function

Subroutine Call_Function calls Function_Two_Return_Example with two
variables, which are 'returned' to the caller

 

[leungkong]

Thanks Shasur. I have changed my code as below although I am not understand
why the function can return myArray(), MyVal.... I will try to read more
about function. Thanks again.

sub test()
Dim myArray() As String
Dim myRange As Range
Dim MyVal As Long
Set myRange = wsData.Range(col_SP & startrow & ":" & col_SP & lastrow)
countUnique myArray(), myRange, MyVal
end sub

Function countUnique(ByRef aArray() As String, ByRef aRange As Range, ByRef
iVal As Long)
Dim myRange As Range
Dim cell As Range
Dim j As Long
Dim iNumCells As Long
Dim iUVals As Long
Dim sUCells() As String
Set myRange = aRange
iNumCells = myRange.Count
ReDim sUCells(iNumCells) As String
iUVals = 0
For Each cell In myRange
If cell.Text > "" Then
For j = 1 To iUVals
If sUCells(j) = UCase(cell.Text) Then
Exit For
End If
Next j
If j > iUVals Then
iUVals = iUVals + 1
sUCells(iUVals) = UCase(cell.Text)
End If
End If
Next cell
Set myRange = Nothing
Set cell = Nothing
If iUVals = 0 Then Exit Function

aArray() = sUCells()
iVal = iUVals
End Function