Change when function is called
 

Hi,
I have the following function that is called everytime a worksheet is
changed, I would like to only allow the function to run on certain
worksheets because I have code on other sheets and having this
function called makes it really slow, so is there a way to specify
which sheets can call the function ?

Thanks in advance

D

**FUNCTION**
Option Base 1
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
Dim Unique() As Variant
Dim u() As Variant
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean
Dim r As Range
Set r = Application.Caller
If IsMissing(Count) Then Count = True
NumUnique = 0
For Each Element In ArrayIn
FoundMatch = False
For i = 1 To NumUnique
If Element = Unique(i) Or Element = 0 Then
FoundMatch = True
GoTo AddItem
End If
Next i
AddItem:
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If
Next Element
If Count Then
UniqueItems = NumUnique
Else
If NumUnique r.Count Then
ReDim Preserve Unique(1 To r.Count)
Unique(UBound(Unique)) = (NumUnique - r.Count) + 1 & " more"
UniqueItems = Application.Transpose(Unique)
ElseIf NumUnique < r.Count Then
ReDim Preserve Unique(1 To r.Count)
For i = NumUnique + 1 To r.Count
Unique(i) = ""
Next
UniqueItems = Application.Transpose(Unique)
Else
UniqueItems = Application.Transpose(Unique)
End If
End If
End Function

Change when function is called
 

you could re-write your function. Using a Dictionary from the Microsoft
Scripting Runtime dll would save lots of work as there is a .EXISTS() method
that would enable you to check if a key already exists...

by populating the dictionary you also get to count the number of items and
get the unique list.



"Darren" wrote in message
...
Hi,
I have the following function that is called everytime a worksheet is
changed, I would like to only allow the function to run on certain
worksheets because I have code on other sheets and having this
function called makes it really slow, so is there a way to specify
which sheets can call the function ?

Thanks in advance

D

**FUNCTION**
Option Base 1
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
Dim Unique() As Variant
Dim u() As Variant
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean
Dim r As Range
Set r = Application.Caller
If IsMissing(Count) Then Count = True
NumUnique = 0
For Each Element In ArrayIn
FoundMatch = False
For i = 1 To NumUnique
If Element = Unique(i) Or Element = 0 Then
FoundMatch = True
GoTo AddItem
End If
Next i
AddItem:
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If
Next Element
If Count Then
UniqueItems = NumUnique
Else
If NumUnique r.Count Then
ReDim Preserve Unique(1 To r.Count)
Unique(UBound(Unique)) = (NumUnique - r.Count) + 1 & " more"
UniqueItems = Application.Transpose(Unique)
ElseIf NumUnique < r.Count Then
ReDim Preserve Unique(1 To r.Count)
For i = NumUnique + 1 To r.Count
Unique(i) = ""
Next
UniqueItems = Application.Transpose(Unique)
Else
UniqueItems = Application.Transpose(Unique)
End If
End If
End Function

Change when function is called
 

Darren

Just after the declaration part add the below code. You can mention the
valid sheets in the String variable...Function will exit if the sheet is not
found in the list.

Dim strSheets as String
strSheets = "Sheet1,Sheet2,Sheet3"
If InStr(1, "," & strSheets & ",", "," & ActiveSheet.Name & _
",", vbTextCompare) = 0 Then Exit Function

If this post helps click Yes
---------------
Jacob Skaria


"Darren" wrote:

Hi,
I have the following function that is called everytime a worksheet is
changed, I would like to only allow the function to run on certain
worksheets because I have code on other sheets and having this
function called makes it really slow, so is there a way to specify
which sheets can call the function ?

Thanks in advance

D

**FUNCTION**
Option Base 1
Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
Dim Unique() As Variant
Dim u() As Variant
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean
Dim r As Range
Set r = Application.Caller
If IsMissing(Count) Then Count = True
NumUnique = 0
For Each Element In ArrayIn
FoundMatch = False
For i = 1 To NumUnique
If Element = Unique(i) Or Element = 0 Then
FoundMatch = True
GoTo AddItem
End If
Next i
AddItem:
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If
Next Element
If Count Then
UniqueItems = NumUnique
Else
If NumUnique r.Count Then
ReDim Preserve Unique(1 To r.Count)
Unique(UBound(Unique)) = (NumUnique - r.Count) + 1 & " more"
UniqueItems = Application.Transpose(Unique)
ElseIf NumUnique < r.Count Then
ReDim Preserve Unique(1 To r.Count)
For i = NumUnique + 1 To r.Count
Unique(i) = ""
Next
UniqueItems = Application.Transpose(Unique)
Else
UniqueItems = Application.Transpose(Unique)
End If
End If
End Function