check date value

[kpgyoh]

Hello,

[IMG]http://i44.tinypic.com/2icb5o5.jpg[/IMG]

I need to check the cells E throughout for:

if the cell contains date older than 2 weeks (today - 14 days)
then delete entire row.

if the cell contains date within 10 weeks (today + 70 days)
then mark cell green.

if the cell doesn't contain any date
then next cell.

I thought i could solve this via conditional formatting but that deleting can only be done by VBA. I need help from you guys.

 

[alvin-chung]

May be you can consider using conditional formatting to 'hide' the entire row by making the font color same as background color instead of deleting it?

 

[kpgyoh]

May be you can consider using conditional formatting to 'hide' the entire row by making the font color same as background color instead of deleting it?

thanks for your reply. yea I did that already and its not really the thing what my adviser wants.
can you help me code ? I guess this would be a loop.

 

[kpgyoh]

I've tried this but it doenst seem to be good enough.

Sub Hide()


Dim cell As Range
For Each cell In Range("E10:E100")
'("Cell(Rows.Count, 5).End(xlUp).Row") '("E10:E100")


Select Case cell


    Case Is < "today-14"
        cell.EntireRow.Delete
    Case Is > "today" & "today+70"
        cell.EntireRow.Interior.ColorIndex = 10
    Case Is = ""
        cell.EntireRow.Interior.ColorIndex = 5
    Case Is > "today+70"
        cell.EntireRow.Interior.ColorIndex = 20
    
End Select
Next


End Sub

 

[alvin-chung]

Perhaps code below will be a good start...

Sub check_date_value()
    For Each rng In Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        'MsgBox rng.Value
        If rng.Value >= Date And rng.Value < Date + 2 Then rng.Interior.color = vbGreen
        If rng.Value <= Date - 14 Then rng.EntireRow.Clear
    Next rng
    Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

 

[kpgyoh]

Perhaps code below will be a good start...

Sub check_date_value()
    For Each rng In Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        'MsgBox rng.Value
        If rng.Value >= Date And rng.Value < Date + 2 Then rng.Interior.color = vbGreen
        If rng.Value <= Date - 14 Then rng.EntireRow.Clear
    Next rng
    Range("E10:E" & Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Thanks for your help alvin, actually it did work but there is something important that was erased (check picture row 4).
Row 4 is the header .. i cant just erase it. maybe you can modify the code to --> it shouldnt erase a cell within range if its "merged"

 

[alvin-chung]

You're welcome.

I couldn't figure out how row 4 erased while the range specified was from E10 downwards
Could you upload a sample spreadsheet so that I can try take a look?

 

[kpgyoh]

You're welcome.

I couldn't figure out how row 4 erased while the range specified was from E10 downwards
Could you upload a sample spreadsheet so that I can try take a look?

sorry I forgot to say, I changed the range from E10 to E1.. the header of each block (rows 4, 11, 117..) shouldnt be deleted.

btw heres a sample file you asked for:

http://speedy.sh/N2Pmr/sample-table.xlsx

 

[alvin-chung]

Try this:

Sub check_date_value()
    Application.ScreenUpdating = False
    
    For Each Rng In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row)
        'MsgBox rng.Value
        If Rng.Value >= Date And Rng.Value < Date + 2 Then Rng.Interior.Color = vbGreen
        If Rng.Value <= Date - 14 And Rng.Value <> "" And Rng.Offset(, -4).Value <> "" Then
            Rng.EntireRow.Delete
            check_date_value
            Exit For
        End If
    Next Rng
    
    Application.ScreenUpdating = True
End Sub