U
Upanisad
Hi there you all!
i've the following problem. I've a database with various fields where
some alphanumeric product codes can be repeated several times. The user
can work on it using Excel filters to mainpulate the values. I use the
SUBTOTAL function on some of these fields to get the filtered sum of
them, but I need to know how many unique codes are shown in the
filtered list (no matter how the filter has been set from the user).
To solve the problem I've built a user defined function that runs
through a given range, builds up an array of unique values and makes a
count of them, ignoring hidden rows (to keep just the filtered,
visible, ones).
The function works ok, except when you delete a row from the sheet!
Through debugging, I've discovered that Excel has no idea if a row is
Hidden or not, when you delete a (different) row! The property Hidden
is unavailable for the whole Sheet and the function ends up with a
runtime error!
Is this a Microsoft bug? Is there a way to avoid this from happening?
The function goes like this:
Function CountSKU(rng As Range)
Dim c As Range, lista() As String, L As Variant
Dim i As Integer, cVal As Variant
ReDim lista(0)
On Error GoTo esci
Application.EnableEvents = False
For Each c In rng.Cells
If c.Rows(1).EntireRow.Hidden = False Then
If c.Value <> Empty Then
cVal = c.Value
For Each L In lista
If StrComp(cVal, L, vbTextCompare) = 0 Then Exit
For
Next L
If L = Empty Then
'If UBound(Filter(lista, cVal, True, vbTextCompare)) =
-1 Then
If lista(0) = Empty Then
lista(0) = CStr(cVal)
Else
i = UBound(lista) + 1
ReDim Preserve lista(i)
lista(i) = CStr(cVal)
End If
End If
End If
End If
Next c
esci:
Application.EnableEvents = True
If Err = 0 Then
If UBound(lista) > 0 Or lista(0) <> Empty Then
ContaSKU = UBound(lista) + 1
Else
ContaSKU = 0
End If
Else
ContaSKU = CVErr(xlErrNA)
End If
End Function
Please note that the method Range.SpecialCells gives a run-time error
as well, in the above circumstances, so it's useless!
BTW, does anybody know if there's a bug in the CurrentRegion method in
Excel 2000?
Here at home with Excel 2003 it works perfectly, but at my office I've
Excel 2000 and avery time the code tells VBA to get a
Range.CurrentRegion the Selection_Change event of the Worksheet
(Range.Parent) starts running! I had to put a load of
Application.EnableEvents=False all around the code! :O
i've the following problem. I've a database with various fields where
some alphanumeric product codes can be repeated several times. The user
can work on it using Excel filters to mainpulate the values. I use the
SUBTOTAL function on some of these fields to get the filtered sum of
them, but I need to know how many unique codes are shown in the
filtered list (no matter how the filter has been set from the user).
To solve the problem I've built a user defined function that runs
through a given range, builds up an array of unique values and makes a
count of them, ignoring hidden rows (to keep just the filtered,
visible, ones).
The function works ok, except when you delete a row from the sheet!
Through debugging, I've discovered that Excel has no idea if a row is
Hidden or not, when you delete a (different) row! The property Hidden
is unavailable for the whole Sheet and the function ends up with a
runtime error!
Is this a Microsoft bug? Is there a way to avoid this from happening?
The function goes like this:
Function CountSKU(rng As Range)
Dim c As Range, lista() As String, L As Variant
Dim i As Integer, cVal As Variant
ReDim lista(0)
On Error GoTo esci
Application.EnableEvents = False
For Each c In rng.Cells
If c.Rows(1).EntireRow.Hidden = False Then
If c.Value <> Empty Then
cVal = c.Value
For Each L In lista
If StrComp(cVal, L, vbTextCompare) = 0 Then Exit
For
Next L
If L = Empty Then
'If UBound(Filter(lista, cVal, True, vbTextCompare)) =
-1 Then
If lista(0) = Empty Then
lista(0) = CStr(cVal)
Else
i = UBound(lista) + 1
ReDim Preserve lista(i)
lista(i) = CStr(cVal)
End If
End If
End If
End If
Next c
esci:
Application.EnableEvents = True
If Err = 0 Then
If UBound(lista) > 0 Or lista(0) <> Empty Then
ContaSKU = UBound(lista) + 1
Else
ContaSKU = 0
End If
Else
ContaSKU = CVErr(xlErrNA)
End If
End Function
Please note that the method Range.SpecialCells gives a run-time error
as well, in the above circumstances, so it's useless!
BTW, does anybody know if there's a bug in the CurrentRegion method in
Excel 2000?
Here at home with Excel 2003 it works perfectly, but at my office I've
Excel 2000 and avery time the code tells VBA to get a
Range.CurrentRegion the Selection_Change event of the Worksheet
(Range.Parent) starts running! I had to put a load of
Application.EnableEvents=False all around the code! :O