Finding and Selecting Cells by Color

[southcali12]

Hi! I have a question regarding my macro. What I want it to do is search for all the cells that are blue colored and select all the cells that are blue colored. I, then, want it to take only the blue colored cells and email them. Help please? I have the email part down, I just can't seem to have the macro only send the blue colored cells.

 

[jolivanes]

How did they become blue? Conditional Formatting?

 

[southcali12]

I created a macro to turn them blue. To go into further detail, I had the macro look for the exact value of "18" in a specific column, and if the column had "18", the entire row was then filled blue.

 

[jolivanes]

WOW.
If you have Excel 2007 or up you'll be mailing 16,384 cells per row found to be blue.
Isn't that a little bit much? Entirely up to you of course.

 

[jolivanes]

This will select all the Blue (vbBlue) colored cells in Column C

Sub Select_Blue_Colored_Single_Cells()
    Dim rCell As Range
    Dim lColor As Long
    Dim rngCol As Range
    Dim rng As Range
    Set rng = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    Set rngCol = Nothing
    For Each rCell In rng
        If rCell.Interior.Color = vbBlue Then
            If rngCol Is Nothing Then
                Set rngCol = rCell
            Else
                Set rngCol = Union(rngCol, rCell)
            End If
        End If
    Next
    rngCol.Select
    Set rCell = Nothing
End Sub

This will select all the Blue (vbBlue) colored cells in Column C and Resize the selection to Column F

Sub Select_Blue_Colored_Cells_Resized()
    Dim rCell As Range
    Dim lColor As Long
    Dim rngCol As Range
    Dim rng As Range
    Set rng = Range("C1:C" & Cells(Rows.Count, 3).End(xlUp).Row)
    Set rngCol = Nothing
    For Each rCell In rng
        If rCell.Interior.Color = vbBlue Then
            If rngCol Is Nothing Then
                Set rngCol = rCell.Resize(, 4)    '<---- Columns C to F
            Else
                Set rngCol = Union(rngCol, rCell.Resize(, 4))    '<---- Columns C to F
            End If
        End If
    Next
    rngCol.Select
    Set rCell = Nothing
End Sub

Would it not be easier to AutoFilter on the value of 18, copy the visible cells(Resized?) and mail?

 

[southcali12]

Haha I didn't even consider that big issue *faceplam* it actually would be better if I filtered the "18" and then just emailed out the visible cells from there lol... but thank you for the codes, I'll let you know how it goes tomorrow!

 

[southcali12]

Thank you for the help - the codes work perfectly! However, since you mentioned the filter and then mailing only the visible cells. Do you think it'd be possible to make a macro for that?

 

[jolivanes]

I don't have any idea what your sheet looks like so there are a lot of assumptions.
The numbers 18 are all in Column H (8).
You have Headers (as you should have) in the first (1) Row.
This example copies the filtered result from Column A to Column P.
You will have a Sheet named "Temp" (without quotation marks) in your workbook and it will be empty.
It will paste the copied cells into Sheet "Temp" starting in cell A1.

If I forgot to mention any other assumptions, let me know.
Try the code on a copy of your workbook just in case.

I trust we will hear what else you need and/or if it worked after changing it to fit the set-up of your sheet.

Sub Try_This_Auto_Filter()
    Application.ScreenUpdating = False
    Range("A1:P" & Range("A" & Rows.Count).End(3)(1).Row).AutoFilter 8, 18
    Range("A2:P" & Range("A" & Rows.Count).End(3)(1).Row).SpecialCells(xlCellTypeVisible).Copy Sheets("Temp").Range("A1")
    ActiveSheet.AutoFilterMode = False
    Application.ScreenUpdating = True
End Sub

 

[southcali12]

It works marvelously! Thank you so much!!

 

[jolivanes]

Nice to hear it works for you.
Thanks for the feedback.
Good luck