Count and print colored cells

[austenr]

I have conditionally formatted the attached spreadsheet to have anything in column E GT 0 highlighted in red.

I need a way to do the following:

Count the cells that are red. And two, write those lines that are red to another worksheet, lets say Sheet2.

I also need to find a way to highlight in blue those cells that are greater than 01/01/2005 in Column D, count them and then write those lines in which the cells are blue to lets say Sheet3.

The problem I am having is I cannot find a way to conditionally format the cells in Column D.

Thanks in advance for your help. I am attaching a partial file for your consideration. The whole file goes from row two to row 16900. Thank you.

[Zack Barresse]

Hi Austen,


First of all, column D is text. Convert all textual numbers to actual numbers. You can do this by many ways. The quickest/easiest method (imho) is to type "1" (without quotes) in a blank cell. Copy that cell. Then select all of column D and go to Edit --> Paste Special --> Multiply.

Then, with the column still selected, go to Format --> Cells.. --> Number (tab) --> Custom (on left) --> "dd/mm/yyyy" (without quotes, on right).

Now with the column still selected go to Format --> Conditional Format --> Formula Is, and type ..

=(D1<>"")*(ROW(D1)<>1)*(D1<$H$3)

I find it's just easier and quicker to format the entire column, if you just want to select your data range, select from "D2 : D100" and the Formula Is ...

=D2<$H$3

Now in H3 I put 1/1/2005. You can replace this if you'd like in your formulas with ..

DATE(2005,1,1)

I usually like to keep things variable so I can change and play around with items; if customization is required.

As for the copying and such of all blue values (Greater Than 1/1/2005) I would try something like this:

Right click your sheet tab, select View Code. Paste this in there ...

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim newWs As Worksheet
    If Intersect(Target, Range("D1")) Is Nothing Then Exit Sub
    If MsgBox("Are you sure you want all values over " & vbCrLf & _
        Range("H3").Value & "?", vbQuestion + vbYesNo) = vbNo Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Range("D:D").AutoFilter Field:=1, Criteria1:=">" & Range("H3").Value
    Range("D:D").SpecialCells(xlCellTypeVisible).Copy
    Set newWs = Sheets("Sheet3")
    With newWs
        .Paste
        .Cells.EntireColumn.AutoFit
        If Err <> 0 Then
            MsgBox "That sheet name already exists!", vbExclamation, "ERROR"
            GoTo skipIt
        Else
            .Name = Me.Range("D1").Value
        End If
    End With
skipIt:
    Me.Activate
    Range("D:D").AutoFilter
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

This will basically trigger/fire anytime you select D1 (which includes selecting the entire column from the column header). You will be prompted and asked if you want to continue. If yes (you won't see it) autofilter will be enabled copying the visible (filtered) cells to Sheet3. Error trapping has been used if sheet three already has the name of D1. Which brings me to a very important point: I utilized H3 for naming the filtering also, and D1 for the naming of the sheet. The information will still be copied though.