Filter by Colour in Microsoft Excel

' Original text from http://www.vbaexpress.com/kb/getarticle.php?kb_id=230#instr


Option Explicit
Sub FilterByColor()



' Assumption: That your colour can be in 2 columns
'
Dim intCol1ForColorCheck As Integer
intCol1ForColorCheck = 11 ' 11 WAS L
Dim intCol2ForColorCheck As Integer
intCol2ForColorCheck = 18

Dim intYellow As Integer
Dim intGreen As Integer
Dim strColourName As String
Dim vRow
intYellow = 6
intGreen = 4
strColourName = "Yellow"
Application.ScreenUpdating = False
Dim cel As Range, rng As Range
Set rng = Sheet1.Range("B2", Sheet1.Range("A65536").End(xlUp).Offset(, 1))
' column 9 after the inserted column has color on it
For Each cel In rng
vRow = cel.Row
If vRow = 230 Then
vRow = vRow ' just to put a debut
End If
If (cel.Offset(, intCol1ForColorCheck - 1).Interior.ColorIndex = intYellow Or _
cel.Offset(, intCol2ForColorCheck - 1).Interior.ColorIndex = intYellow) Then
' -1 as we have entered a column to put the name of hte color
'** Used to filter further along in the Sub Routine
cel.Value = strColourName

End If
Next cel
'** Start AutoFilter Process
With Sheet1.Rows("1:65536")
.AutoFilter
'** Use temporary column 1
.AutoFilter Field:=2, Criteria1:=strColourName
End With
Application.ScreenUpdating = True
End Sub

Sub UnFilterMe()
Application.ScreenUpdating = False
'** Check if the AutoFilter is on
If Sheet1.AutoFilterMode Then
'** If on, turn it off
Sheet1.Cells.AutoFilter
'** Also glear the "Green" cells
Sheet1.Range("B2", Sheet1.Range("B65536").End(xlUp)).Clear
'** If not, do nothing
End If
Application.ScreenUpdating = True
End Sub

Sub UnColorAll()
'** Uncolor all cells, to reset
With Sheet1.Range("2:65536")
'** 0 is for no color
.Interior.ColorIndex = 0
End With
End Sub


' How to use:

1. From Excel, hit Alt + F11.
2. From the VBE menu select Insert -> Module.
3. Copy/Paste code into right pane.
4. Go through commented code (green) and change where dictated appropriate; noted as such.
5. Press Alt + Q
6. Save file before running.
7. Note: Default will dictate a blank column be directly to the right of the range in question, change as necessary.