Set Range of visible Autofilltered columns VBA?

[Dennis]

I have a spreadsheet of 30 columns and 5000 rows. The first row is a label row.

I applied an autofilter (like greater than 20) to one of the columns and am
showing the visible rows that satisfy the autofiltered column. I wish to color
the maximum and minimum values in each of the visible autofiltered columns

The code below takes a very loong time to complete AND it somehow increases the
rows in the spreadsheet to the maximum 65000.

What am I doing wrong?

Thanks for any help.

my code snippet is:
SS = ActiveSheet.Name
Set curwk = Sheets(SS)
With curwk
'Reset All Interior cells to standard color index
.Cells.Select
Selection.Interior.ColorIndex = xlNone
'Cells.Deselect
.Range("A2").Select

For ii = 2 To LastCol
Set rng = .Columns(ii).SpecialCells(xlCellTypeVisible)
MaxVal = Application.Max(rng)
MinVal = Application.Min(rng)
For Each myCell In rng
CellVal = myCell.Value
If IsNumeric(CellVal) = True Then
If CellVal = MaxVal Then myCell.Interior.ColorIndex = 4
If CellVal = MinVal Then myCell.Interior.ColorIndex = 6
End If
Next
Next ii
End With

 

[Dave Peterson]

I think you have another problem. When I filtered the range and tried to reset
the existing colors, the colors on the hidden rows didn't get reset to xlnone.

I think you'll have to clear the cells before you start your code.

And you'll want to limit your loop through the range to just the autofilter
range.

(And I'd try to skip the first row in autofilter range, too)

Option Explicit
Sub testme02()

Dim SS As String
Dim curWk As Worksheet
Dim ii As Long
Dim MaxVal As Double
Dim MinVal As Double
Dim LastCol As Long
Dim rng As Range
Dim myCell As Range
Dim CellVal As Double

SS = ActiveSheet.Name
Set curWk = Sheets(SS)
'or
'set curwks = activesheet
With curWk
'Reset All Interior cells to standard color index
'problems here!
.Cells.Interior.ColorIndex = xlNone
With .AutoFilter.Range
LastCol = .Columns(.Columns.Count).Column
For ii = 2 To LastCol
Set rng = .Resize(.Rows.Count - 1).Offset(1, 0).Columns(ii) _
.Cells.SpecialCells(xlCellTypeVisible)
MaxVal = Application.max(rng)
MinVal = Application.Min(rng)
For Each myCell In rng.Cells
CellVal = myCell.Value
If IsNumeric(CellVal) = True Then
If CellVal = MaxVal Then myCell.Interior.ColorIndex = 4
If CellVal = MinVal Then myCell.Interior.ColorIndex = 6
End If
Next myCell
Next ii
End With
End With
End Sub

 

[Dave Peterson]

But the visible cells did get the colorindex set to xlnone.

 

[Dennis]

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]

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.

 

[Dennis]

Hi Dave,

I tried both methods. That is, limiting rng to exclude the header row and not.

It seems that Application.Max(rng) and Min ignores non numerics so the exclusion
of the header row is not needed here. I'm not sure if the
Application.Average(rng) excludes non numerics or includes them by putting them
as zero.

Thanks again for your help.

Dennis

 

[Dave Peterson]

=average() will ignore the strings.

It won't include them as 0's.
Average = Sum/CountOfNumbers

The countofnumbers won't be increased so the =average() won't be affected.