My suggested code did not include the header row in the range to be inspected.

You may want to limit your loop to just the usedrange.

wrote:

Hi Dave,

Thanks for your code and time.

I found a similar solution code below. However, I encountered a problem when I
wanted to color a spreadsheet that was not autofiltered. For a non autofiltered
spreadsheet, the "For Each myCell in rng" would not work. I had to code an "if
else" that used "For irow =2 to LastRow" for the non-autofiltered SS as you can
see below.

I'll have to look if my code below clears the colors. I moved the xlNone out of
the loop. I haven't checked this before because after the macro I usually print
and exit.

====ColorColumnMaxMin code============
SS = ActiveSheet.Name
LastRow = Sheets(SS).Cells(Rows.Count, "a").End(xlUp).Row
LastCol = Sheets(SS).Range("A2").End(xlToRight).Column
'Reset All Interior cells to standard color index
Sheets(SS).Cells.Select
Selection.Interior.ColorIndex = xlNone
'Cells.Deselect
Sheets(SS).Range("A1").Select
Set curwk = Sheets(SS)

With curwk
For ii = 2 To LastCol
If .AutoFilterMode = True Then
Set rng = .AutoFilter.Range
Set rng = Intersect(rng, Columns(ii))
Set rng = rng.SpecialCells(xlCellTypeVisible)
Else
Set rng = .Columns(ii)
End If
MaxVal = Application.Max(rng)
MinVal = Application.Min(rng)
If .AutoFilterMode = False Then
For irow = 2 To LastRow
CellVal = .Cells(irow, ii)
If IsNumeric(CellVal) = True Then
If CellVal = MaxVal Then Cells(irow, ii).Interior.ColorIndex = 4
If CellVal = MinVal Then Cells(irow, ii).Interior.ColorIndex = 6
End If
Next irow
Else
For Each myCell In rng
'CellVal = myCell.Value
'If ii = 3 Then MsgBox myCell.Value & " " & MaxVal
If IsNumeric(myCell) = True Then
If myCell.Value = MaxVal Then
myCell.Interior.ColorIndex = 4
'MsgBox (.Cells(1, ii) & " " & myCell.Value & " row=" & myCell.Row)
End If
If myCell.Value = MinVal Then myCell.Interior.ColorIndex = 6
End If
Next
End If
Next ii
End With

--

Dave Peterson