Clear all cells that aren't blue within a ceratin range

[cgebke]

I am working on an excel calendar that has names listed down the left and numbers along the top depicting a certain day of a certain month. There are different tabs for each month. Different types of events are colored differently on the calendar (ex: sick days are blue, projects are green, holidays are purple, etc).<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I am trying to find a way to clear the cells of data, color, and formatting, that don't meet a certain color criteria. For example if I want to only see sick days I would click a button and the calendar would be cleared except for people with sick days listed for that month. It would be even better if the blank rows would be deleted, but I am tackling one problem at a time.<o></o>
<o></o>
I have a macro now that copies the current month to a separate sheet that can be edited. I would use the above macro to edit the copy, thereby keeping the original data intact. Any advice and help the forum could offer would be greatly appreciated. Thank you in advance. <o></o>

 

[cgebke]

Here is some code I've been using and I am half way there.

Sub Find_Sick()
Dim i1 As Long
Dim iMaxR As Long, iMaxC As Long
Dim sText As String
searchText = "Sick"
iMaxR = Cells.SpecialCells(xlCellTypeLastCell).Row
iMaxC = Cells.SpecialCells(xlCellTypeLastCell).Column
For i1 = iMaxR To 1 Step -1
If Range(Cells(i1, 1), Cells(i1, iMaxC)).Find(searchText) Is Nothing Then
Rows(i1).EntireRow.Delete
End If
Next i1
End Sub

This deletes all rows without the word "Sick" in them. What I am trying to do now is change it from finding a word to finding a cell color. I want to delete all rows that don't have a blue cell in them. I can't figure out what to change the text to in order to meet that goal. I would prefer to use the RGB option instead of the index to give myself a little more options with color. As always, thanks for the assistance.

 

[AD_Taylor]

Working with your code:

Sub Find_Sick()
Dim i1 As Long
Dim iMaxR As Long, iMaxC As Long
Dim sText As String
searchText = "Sick"
iMaxR = Cells.SpecialCells(xlCellTypeLastCell).Row
iMaxC = Cells.SpecialCells(xlCellTypeLastCell).Column
For i1 = iMaxR To 1 Step -1
If Range(Cells(i1, 1), Cells(i1, iMaxC)).Find(searchText) Is Nothing Then
Rows(i1).EntireRow.Delete
End If
Next i1
End Sub

And the changed version:

Sub Find_And_Delete_Blue()

Dim i1 As Long
Dim iMaxR As Long, iMaxC As Long

Dim checkRng As Range, currCell As Range
Dim redRGB As Integer, blueRBG As Integer, greenRGB As Integer
Dim rowHasBlue As Boolean

iMaxR = Cells.SpecialCells(xlCellTypeLastCell).Row
iMaxC = Cells.SpecialCells(xlCellTypeLastCell).Column

redRGB = 123
blueRGB = 123
greenRGB = 123

For i1 = iMaxR To 1 Step -1

    Set checkRng = Range(Cells(i1, 1), Cells(i1, iMaxC))
    rowHasBlue = False

    For Each currCell In checkRng
    
        If currCell.Interior.Color = RGB(redRGB, greenRGB, blueRGB) Then
        
            rowHasBlue = True
            
        End If
        
    Next currCell


    If rowHasBlue = False Then
    
        Rows(i1).EntireRow.Delete
        
    End If
    
Next i1

End Sub

Make sure you save your work before trying it as it is deleting data but this should work.
Just need to change the RBG values I've set in variables to match the ones you want to look for - at the moment its looking for a shade of dark grey.

Hope this helps!
Adam

 

[cgebke]

Thank you so much for the quick response. I haven't had a chance to try it yet as my spread sheet is at work. Do you know how I could not apply this search to Row 1. Row 1 is the days of the month and also was deleted when I ran my original macro. Thank you again and I look forward to trying your code.

 

[cgebke]

just made a quick worksheet at home and adjusted it to skip row one. Also it looks like your code will work. Thanks again for the help. I will check again tomorrow and give you the final word.

 

[AD_Taylor]

just made a quick worksheet at home and adjusted it to skip row one. Also it looks like your code will work. Thanks again for the help. I will check again tomorrow and give you the final word.

I know you've said that its already done but just to make sure, its very simple. For this line:

For i1 = iMaxR To 1 Step -1

change it to:

For i1 = iMaxR To 2 Step -1

This loop is going from the final row on the sheet and working its way up the rows until it gets to whichever number row you put as the final row. The final row number is the bit I bolded.

Glad I could help!

 

[cgebke]

My next step is to clear all cells (except row 1,dates, and column 1,names,) in the remaining rows of color and text, except for the designated color cells (in this case blue). I haven't started to work on this yet so I don't have any code to start with.

Since I hate to ask others to do work for me, I hope to have the beginning of this code up tomorrow if I cant figure it out on my own. I'm without question a novice, unlike the genius' on this site (AD_Taylor included). If this is something considered simple and would not take to much time I would greatly appreciate further assistance/guidance before I get started on part 2.

 

[AD_Taylor]

Thanks for the compliment , but I don't consider myself a genius lol.

I started learning VBA Code about a year ago and am still learning even now. Regularly make errors with my code and all kinds :D

I think your next step is simple enough to code. Just to make sure you want to remove any colors that do not match the designated color and remove all text entered anywhere apart from in row 1 and column A?

If you want to have a go at it first, go ahead. Just post here with what you get and I'll help if needed.

 

[cgebke]

That is spot on. If this is something you think is easy I would love to see what you would come up with. As mush as I would like to work on this, and my skills, I am a little short on time as I am deploying soon and trying to get this done before I go. Thanks again for the help.

 

[AD_Taylor]

Ok, since you asked and I don't mind writing code for people (lets me test myself and help others ) here's a first attempt.

Bear in mind that this one isn't actually tested:

Sub RemoveColorsAndText()

Dim i1 As Long
Dim iMaxR As Long, iMaxC As Long

Dim checkRng As Range, currCell As Range
Dim redRGB As Integer, blueRBG As Integer, greenRGB As Integer

iMaxR = Cells.SpecialCells(xlCellTypeLastCell).Row
iMaxC = Cells.SpecialCells(xlCellTypeLastCell).Column

redRGB = 123
blueRGB = 123
greenRGB = 123

Set checkRng = Range(Cells(2, 2), Cells(iMaxR, iMaxC))

For each currCell in checkRng

        If currCell.Interior.Color <> RGB(redRGB, greenRGB, blueRGB) Then
        
            'This is the bit I'm not sure about
            'It should set the color options to 'No Fill' if the color doesn't match the one specified
              currCell.interior.Color = xlColorIndexNone
            
        End If

        currCell.ClearContents
        
Next currCell

End Sub