check date value

kpgyoh

New Member
Joined
Jan 6, 2014
Messages
9
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.
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.

alvin-chung

Active Member
Joined
Nov 24, 2013
Messages
361
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

New Member
Joined
Jan 6, 2014
Messages
9
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.:confused::confused:
 

kpgyoh

New Member
Joined
Jan 6, 2014
Messages
9
I've tried this but it doenst seem to be good enough.

Code:
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

Active Member
Joined
Nov 24, 2013
Messages
361
Perhaps code below will be a good start...

Code:
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

New Member
Joined
Jan 6, 2014
Messages
9
Perhaps code below will be a good start...

Code:
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

Active Member
Joined
Nov 24, 2013
Messages
361
You're welcome.

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

kpgyoh

New Member
Joined
Jan 6, 2014
Messages
9
You're welcome.

I couldn't figure out how row 4 erased while the range specified was from E10 downwards :confused:
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:
Code:
http://speedy.sh/N2Pmr/sample-table.xlsx
 

alvin-chung

Active Member
Joined
Nov 24, 2013
Messages
361
Try this:
Code:
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
 

Forum statistics

Threads
1,172,172
Messages
5,879,459
Members
433,434
Latest member
skk0048

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top