Macro for highlighting dates in red and orange

Hi,

Can someone please help me edit an existing macro? Need 3 changes –

1) The macro creates a new workbook and also copies the hidden rows from the original file. I don’t need the hidden rows on the new workbook
2) On the new workbook sheet1, sheet2 & sheet3 are blank and need to be deleted.
3) On the new workbook “decision date” column any date before today’s date should be highlighted in red and anything = > today’s date should be highlighted in orange

Hope someone can help me out with this please!!!

Have attached sample data and vba code pasted below –

Option Explicit

Dim FName As String
Dim SName As String
Dim lrow As Long
Dim i As Long

Sub filter_rows()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Workbooks.Add
ActiveWorkbook.SaveAs ("Output File")
FName = ActiveWorkbook.Name

With ThisWorkbook.Worksheets("Pipeline (Current wk)")
    lrow = .Range("A" & .Rows.Count).End(xlUp).Row
    For i = 15 To lrow
        If .Range("U" & i).Value <= Date + 7 Then
            SName = .Range("X" & i).Value
            If Not Evaluate("ISREF('" & SName & "'!A1)") Then
                Workbooks(FName).Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = SName
                .Rows("14:14").Copy Workbooks(FName).Worksheets(SName).Range("A1")
            End If
            .Rows(i & ":" & i).Copy Workbooks(FName).Worksheets(SName).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        End If
    Next i
End With

With Workbooks(FName)
    
End With

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

“today” is volatile. Today “today” means 20 July. Tomorrow “today” means 21 July
So you need automation that on each day it should color correctly.
So I used an event handler which runs a standard macro , that is everyday when you open the file coloring will be done correctly

The following macro may be parked in a standard module in vb editor.

'On the new workbook “decision date” column any date before today’s
'date should be highlighted in red and anything = > today’s
'date should be highlighted in orange


'ORANGE IS NOT A PRIMARY COLOR. SO I USED YELLOW. IF YOU INSIST ON ORANGE FIRND OUT
'RGB NUMBER FOR ORANGE
‘the above 2 paras are only comments. May be removed later.

Sub test()
Dim r As Range, filt As Range, j As Long
j = Range("U1").Column - Range("M1").Column + 1
Application.DisplayAlerts = False
Worksheets("Pipeline (Current wk)").Activate
ActiveSheet.Cells.Interior.ColorIndex = xlNone

Set r = Range(Range("M14"), Cells(Rows.Count, Range("M14").End(xlToRight).Column).End(xlUp))
MsgBox r.Address
r.AutoFilter field:=j, Criteria1:="<" & Date
Range(Range("u14"), Cells(Rows.Count, "U").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Interior.ColorIndex = 3
ActiveSheet.AutoFilterMode = False

r.AutoFilter field:=j, Criteria1:=">=" & Date
Range(Range("u14"), Cells(Rows.Count, "U").End(xlUp)).SpecialCells(xlCellTypeVisible).Cells.Interior.ColorIndex = 6
ActiveSheet.AutoFilterMode = False
Range("U14").Interior.ColorIndex = xlNone



Application.DisplayAlerts = True

End Sub

Click Developer ribbon and click vbeditor (extreme left). If necessary click control + R
You get the project window on the left with list of open workbooks names
Go to the relevant workbook and right click “thisworkbook” and click view code
In the window that comes up copy this event handler

Private Sub Workbook_Open()
test
End Sub

Save the file.
I am sure you know how to open a file which is macro enabled.
Open and see what happens

For test purposes
Highlight complete column U and
Click Home ribbon and click “fill color” and click “nofill”

The colors will be removed from cells in column U
Save the file and close
Again open what happens!!
I am also sending the file now called "sunil.xlsm" as attachment

remove sheet2 and sheet 3 manually. once removed it will not come in the macro. that is why manual removal woulld be bett


THERE IS NOT NEED FOR A NEW WORKBOO. IF YOU NEED YOU CAN SAVE THE ORIGINAL FILE (BEFORE ADDSING MACROS) SOME WHERE ELSE.