If fuction with two dates and loop till last row visible cell

[Raj Nadar]

Hello Team
We require formula from cell no B5 to B25
A5 Cell have certain date and B4 cell have also certain date what is required here for macro
(B4 - A5) < 365 = red color should be filled
else blue color
loop next
(B4 - A6) < 365 = red color should be filled
note B4 is fixed cell and A column keep changing until the date is available in cell.
pls note I need to fill the color only and formula should be build within the macro and decide the color
Thanks

 

[p45cal]

Sub blah()
Set myRng = Range("A5").CurrentRegion
Set myRng = Intersect(myRng, myRng.Offset(1, 1))
HdrRow = myRng.Row - 1
Hdrcolm = myRng.Column - 1
For Each cll In myRng.Cells
  If (Cells(HdrRow, cll.Column).Value - Cells(cll.Row, Hdrcolm).Value) < 365 Then cll.Interior.Color = vbRed Else cll.Interior.Color = vbBlue
Next cll
End Sub

or with conditional formatting:

Sub blah2()
Set myRng = Range("A5").CurrentRegion
Set myRng = Intersect(myRng, myRng.Offset(1, 1))
With myRng
  .Interior.Color = vbBlue
  .FormatConditions.Delete
  With .FormatConditions.Add(Type:=xlExpression, Formula1:="=(" & myRng.Cells(1).Offset(-1).Address(1, 0) & " - " & myRng.Cells(1).Offset(, -1).Address(0, 1) & ") < 365")
    .Interior.Color = 255
    .StopIfTrue = False
  End With
End With
End Sub