Function Error

[stuartgb100]

Hi,

I have a function which checks for fill in column K.
The cells to be checked are defined by rng.
There is red fill in K1999.

The function is called by the Worksheet_Change event.

If I click on a cell in col D and enter a value, the function runs
and the value in K2000 becomes ERROR
If I click on another cell in col D and enter a value, the function
runs and K2000 becomes 0.00 as a result of a sum formula.
The red fill is still in K1999.

I keep entering values in col D and the results keep alternating,
first Error then 0.00.

Here is the code:



Function CheckForFill()
Dim rng As Range
'Assumes the correct row number for TotalCell is in E1.
'Uses E1 to set the user data range.
'Checks for a red cell in col K within the data range.
'If found, TotalCell is marked "ERROR".
'If no red cell, then it puts the sumformula in TotalCell.
CheckForFill = False
Set rng = Range("K4", ("K") & Range("E1").Value - 1)
If ActiveSheet.AutoFilterMode = True Then
rng.AutoFilter
rng.AutoFilter Field:=1, Operator:=xlFilterNoFill
End If

If Not rng.SpecialCells(xlCellTypeVisible).Count = rng.Count Then
CheckForFill = False 'found a fill cell(s)

With Range("K" & Range("E1").Value)
.Value = "ERROR"
.Interior.Color = 16777215
.Interior.ColorIndex = 0
End With

rng.AutoFilter
Exit Function
Else
CheckForFill = True 'no 'fill' cells
Range("K" & Range("E1").Value) = Application.Sum(rng)
Range("K" & Range("E1")).Interior.ColorIndex = 0
End If
rng.AutoFilter
Range("A1:K2").Locked = True
Range("A" & Range("E1").Value, "K" & Range("E1").Value).Locked = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True

End Function



Thanks.

[mdmackillop]

Can you post a sample workbook?

[SamT]

What is the problem?

[stuartgb100]

I will try to add a simple workbook.

The total cell is K500.
The sumformula for K500 should only exist if the range K4:K499 has no fill colour.
Currently K499 is red

Enter values in say A4:J499 to trigger the SheetChange code which will then
call the function.

On my machine the results in K500 alternate between ERROR and Sumformula.

Confused.

Thanks.

[mdmackillop]

Simpler to use Find rather than Filter

Set rng = Range("K4", ("K") & Range("E1").Value - 1)
Application.FindFormat.Interior.Color = 255
Set c = rng.Find(What:="", SearchFormat:=True)
If c Is Nothing Then
With Range("K" & Range("E1").Value)

[stuartgb100]

Many thanks, I'll amend it.

Out of interest, did you duplicate my results and if so,
why does the result alternate ?

Thanks.

[SamT]

The Problem is in the 3 AutoFilter on/off logic codes

Try this

Sub Check4Colors()
Dim rngValues As Range
Dim rngTotal As Range
Dim FoundColor As Range
Dim ValuesCount As Long

With ActiveSheet
Set rngTotal = .Range("K" & .Range("E1").Value)
Set rngValues = Range(.Range("K4"), rngTotal.Offset(-1))
End With

ValuesCount = WorksheetFunction.CountA(rngValues)

Application.FindFormat.Interior.ColorIndex = 3
Set FoundColor = rngValues.Find("*")

With rngTotal
If FoundColor Is Nothing And rngValues.Count = ValuesCount Then
.Value = WorksheetFunction.Sum(rngValues)
.Interior.ColorIndex = xlColorIndexNone
Else
.Value = "ERROR"
.Interior.ColorIndex = 3
End If
End With
End Sub