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

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

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

ADVERTISEMENT

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

ADVERTISEMENT

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,136,354
Messages
5,675,301
Members
419,560
Latest member
g3org

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