英文:
Vba code for overduedate cell coloring in excel
问题
I am trying to set up VBA code that will check if a date is overdue and color the cell correspondingly, but I can't make it work automatically on opening the file; it only works on changes.
Any suggestions?
I tried this code, but I suppose something is off with it...
Private Sub Workbook_Open()
' Call the Worksheet_Change event to apply initial formatting
Sheet1_WorksheetChange ThisWorkbook.Sheets("2023").Range("E11:E" & ThisWorkbook.Sheets("2023").Cells(Rows.Count, "E").End(xlUp).Row)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if the changed range intersects with the date column
If Not Intersect(Target, Me.Range("E11:E" & Me.Cells(Rows.Count, "E").End(xlUp).Row)) Is Nothing Then
Sheet1_WorksheetChange Intersect(Target, Me.Range("E11:E" & Me.Cells(Rows.Count, "E").End(xlUp).Row))
End If
End Sub
Private Sub Sheet1_WorksheetChange(ByVal Target As Range)
Dim cell As Range
' Loop through each cell in the changed range
For Each cell In Target
' Check if the date is overdue (today or earlier)
If cell.Value <= Date Then
' Color the cell red
cell.Interior.Color = RGB(255, 0, 0) ' Red
ElseIf cell.Value <= Date + 14 And cell.Value > Date + 7 Then
' Color the cell orange
cell.Interior.Color = RGB(255, 165, 0) ' Orange
ElseIf cell.Value <= Date + 7 Then
' Color the cell yellow
cell.Interior.Color = RGB(255, 255, 0) ' Yellow
End If
Next cell
End Sub
(Note: This code is in English, as translating VBA code line by line could lead to misunderstandings.)
英文:
I am trying to set up vba code that will check if date is overdue and color the cell coressponsivle, but i cant make it work automaticaly on openninf file, it only works on change..
Any suggestions?
I tryed this code but i suppose somethings is off with it..
Private Sub Workbook_Open()
' Call the Worksheet_Change event to apply initial formatting
Sheet1_WorksheetChange ThisWorkbook.Sheets("2023").Range("E11:E" & ThisWorkbook.Sheets("2023").Cells(Rows.Count, "E").End(xlUp).Row)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' Check if the changed range intersects with the date column
If Not Intersect(Target, Me.Range("E11:E" & Me.Cells(Rows.Count, "E").End(xlUp).Row)) Is Nothing Then
Sheet1_WorksheetChange Intersect(Target, Me.Range("E11:E" & Me.Cells(Rows.Count, "E").End(xlUp).Row))
End If
End Sub
Private Sub Sheet1_WorksheetChange(ByVal Target As Range)
Dim cell As Range
' Loop through each cell in the changed range
For Each cell In Target
' Check if the date is overdue (today or earlier)
If cell.Value <= Date Then
' Color the cell red
cell.Interior.Color = RGB(255, 0, 0) ' Red
ElseIf cell.Value <= Date + 14 And cell.Value > Date + 7 Then
' Color the cell orange
cell.Interior.Color = RGB(255, 165, 0) ' Orange
ElseIf cell.Value <= Date + 7 Then
' Color the cell yellow
cell.Interior.Color = RGB(255, 255, 0) ' Yellow
End If
Next cell
End Sub
答案1
得分: 2
所有这些宏都在 Sheet1 的代码中吗？Workbook_Open() 宏应该在 ThisWorkbook 的代码中。Worksheet_Change() 宏应该在你希望它运行的工作表的代码中。
英文:
Are all of those macros in the Sheet1 code? A Workbook_Open() macro should be in the ThisWorkbook code. A Worksheet_Change() macro should be in the code of the whichever sheet you want it to run on.
答案2
得分: 1
如FunThomas所示，您可以轻松使用条件格式设置来完成此操作，就像这个示例中的操作一样：
为了完成此操作，我已经应用了突出显示规则，并使用了“管理规则”以创建它们的层次结构（请参阅“如果为真则停止”按钮）。
英文:
As indicated by FunThomas, you can easily do this using conditional formatting, like in this example:
In order to get this done, I've applied highlighting rules, and used "Manage rules" in order to create a hierarchy in them (see "Stop if true" button).
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论