What code is required to format cells based on dates and adjacent text-CodePudding

I am struggling to code cello formats through VBA, I was struggling to do what is required through conditional formatting.

Firstly, I require any cells with a date occurring within 1 month of the current date to be filled orange. Secondly, any cells with a date before the current date to be filled red. I was able to achieve this easily with conditional formatting.

The next step is where I thought VBA may be easier. If a check mark appears in the cell adjacent to a date cell, then the date cell (and check mark cell) is to be filled green. I couldn't get something this specific to work with conditional formatting.

Examples of what I am trying to achieve are shown in the attached image.

The macro I was working on is below, but the logic just fills any empty check mark cells with orange which I understand. I am also struggling to understand the language required for comparing dates.

Sub green()

For Each Cell In Worksheets("Base Data").Range("F3:P10000")
  If Cell.Value = ChrW(&H2713) Then
    Cell.Offset(0, -1).Interior.Color = RGB(146, 208, 80)
  ElseIf Cell.Value < (Date   30) Then
    Cell.Interior.Color = RGB(255, 192, 80)
  ElseIf Cell.Value < Date Then
    Cell.Interior.Color = RGB(255, 0, 0)
  Else
  End If
  Next
  
End Sub

I then also need to be able to filter any rows containing an orange or red cell using the buttons at the top.

Any help would be much appreciated.

Thanks.

example

CodePudding user response：

Below is a rewrite of your code.

I have;

Used "Y" instead of the tick because it was easier to create the example that way.
Used vb constants for the colours for readability sake, your RGB values are fine to use.
Re-ordered the If conditions - See Below.
Added an extra conditional check to avoid filling blank cells or dates > 30 days ahead.

The biggest issue with your code is it's checking if the cell value is < today 30 and colours the cell orange before assessing if the value is just < Today. If the date in the cell satisfies the condition < Today 30 ** it is also satisfying the condition < today**. Because you check for < Today after < Today 30 the code to colour red never executes, it's satisfied the < Today 30 condition and has coloured the cell orange already.

Sub Olly()
    Dim TodaysDate As Date
    Dim TargetCell As Range
    
    TodaysDate = Date
    
    For Each TargetCell In Me.Range("B2:G5")
        If TargetCell.Value = "Y" Then
            TargetCell.Offset(0, -1).Interior.Color = vbGreen
        ElseIf Not TargetCell.Value = "" Or TargetCell.Value >= (TodaysDate   30) Then
            If TargetCell.Value <= (TodaysDate) Then
                TargetCell.Interior.Color = vbRed
            ElseIf TargetCell.Value <= (TodaysDate   30) Then
                TargetCell.Interior.Color = vbYellow
            End If
        End If
    Next TargetCell
End Sub

Example;

Please note: I have not added any conditional formatting to highlight the 2 last columns for Due 30 and Overdue.