Change to a Specified Range

[Anne Troy]

I'm using this code from the "more than 3" conditional formats code, and I want to specify it to work only on A2 and down:

On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
    If Rng1 Is Nothing Then
        Set Rng1 = Range(Target.Address)
    Else
        Set Rng1 = Union(Range(Target.Address), Rng1)

I also assume I don't need this line 'cause I'm doing an aging report:

Option Compare Text 'A=a, B=b, ... Z=z

[Jacob Hilderbrand]

Try something like:

If Intersect(Range("A2:A65536"),Target) Is Nothing Then
Exit Sub
End If

Option Compare Text will make text non case sensitive.

[Paleo]

For an aging report you dont need Option Compare Text as you are working on numbers but if have text on it, its better you use it.

[Anne Troy]

Okay. Here's the deal. In Column A, I have the "Date of Invoice"
In column B, I have =Now()-A2

That gives me the number of days out.
What I'd LOVE to do is have conditional formatting work on the dates column in A (instead of having to even HAVE column B), but I'll settle for B. I want the conditional formatting to work on B when I change A.

Want a file?

[Norie]

What is the actual condition you want to apply?

Can't you just select column B and then use a formula based on the value in column A for the conditional formatting?

[Jacob Hilderbrand]

You could make the Conditional Formatting something like this.

Select from A2 down making sure that A2 is active.

{Formula Is} =Today()-A2 > ...

Or < Or = whatever number of days you want.

Also, files always help.

[Norie]

DRJ

Is it not Column B the conditional formatting is to be applied to?

[Anne Troy]

Sorry, guys. Norie, you're right, I should have said.

I want:

Anything older than 120 days to have fill 3.
Anything older than 90 to have fill 36.
Anything older than 60 to have fill 35.
Anything older than 30 to have fill 6.

So, I have 4 conditions, see?
Here's the code I have so far, based on Jake's lovely KB at http://www.vbaexpress.com/kb/getarticle.php?kb_id=90 :

Option Compare Text 'A=a, B=b, ... Z=z
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
    Dim Rng1 As Range
On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
    On Error GoTo 0
If Intersect(Range("b2:b65536"), Target) Is Nothing Then
    Exit Sub
End If
Set Rng1 = Union(Range(Target.Address), Rng1)
For Each Cell In Rng1
        Select Case Cell.Value
        Case vbNullString
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        Case Is > 120
            Cell.Interior.ColorIndex = 3
            Cell.Font.Bold = True
        Case Is > 90
            Cell.Interior.ColorIndex = 36
            Cell.Font.Bold = True
        Case Is > 60
            Cell.Interior.ColorIndex = 35
            Cell.Font.Bold = True
        Case Is > 30
            Cell.Interior.ColorIndex = 6
            Cell.Font.Bold = True
        Case Else
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        End Select
    Next
End Sub

Oops. Option Compare text line deleted.

[mdmackillop]

Hi DB,
How about a slight modification to write the formula into Column B when you enter a date in col A

Option Compare Text 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng3 As Range
Set Rng3 = Range("A2:A65536")
If Intersect(Target, Rng3) Is Nothing Then Exit Sub
Application.EnableEvents = False
SetFormula Target
DoFormat Target
Application.EnableEvents = True
End Sub
 
Sub SetFormula(Target)
Target.Offset(0, 1).FormulaR1C1 = "=TODAY()-RC[-1]"
End Sub
 
Sub DoFormat(Target)
Dim Cell As Range
Dim Rng1 As Range, Rng2 As Range
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
Set Rng2 = Intersect(Range("B2:B65536"), Rng1)
For Each Cell In Rng2
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case Is > 120
Cell.Interior.ColorIndex = 3
Cell.Font.Bold = True
Case Is > 90
Cell.Interior.ColorIndex = 36
Cell.Font.Bold = True
Case Is > 60
Cell.Interior.ColorIndex = 35
Cell.Font.Bold = True
Case Is > 30
Cell.Interior.ColorIndex = 6
Cell.Font.Bold = True
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End Sub

[Anne Troy]

SWEET!!
Yoodaman.

Okay, guys. One more thing. I want to show this several ways.
First = conditional formatting, which you've helped me with.
Second = putting X's in 30, 60, 90, and 120-day columns, which I didn't need help with.
Third = showing how many days by displaying "", 30, 60, 90, or 120 in ONE column. Can y'all help me with a formula for that without a vlookup? I'm not very good at all those if/ands I'm afraid.

Nevermind. I don't know WHAT I was thinking!!

=IF(AND(NOW()-A2>=30,NOW()-A2<60), 30, IF(AND(NOW()-A2>=60, NOW()-A2<90), 60, IF(AND(NOW()-A2>=90, NOW()-A2<120), 90, IF(NOW()-A2>=120, 120, ""))))

[mdmackillop]

Hi DB, If you don't need column B and just want to colour the dates, this should do it.

Option Compare Text
Option Explicit
 
Private Sub Worksheet_Change(ByVal target As Range)
    Dim Rng1 As Range
    Set Rng1 = Range("A2:A65536")
    If Intersect(target, Rng1) Is Nothing Then Exit Sub
Application.EnableEvents = False
    DoFormat2
    Application.EnableEvents = True
End Sub
 
Sub DoFormat2()
Dim Cell As Range
    Dim Rng1 As Range
Set Rng1 = Range("a2:a65536").SpecialCells(xlCellTypeConstants, 1)
For Each Cell In Rng1
    Debug.Print Cell.Address
        Select Case Int(Now()) - Cell.Value
        Case vbNullString
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        Case Is > 120
            Cell.Interior.ColorIndex = 3
            Cell.Font.Bold = True
        Case Is > 90
            Cell.Interior.ColorIndex = 36
            Cell.Font.Bold = True
        Case Is > 60
            Cell.Interior.ColorIndex = 35
            Cell.Font.Bold = True
        Case Is > 30
            Cell.Interior.ColorIndex = 6
            Cell.Font.Bold = True
        Case Else
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        End Select
    Next
End Sub

A slight mod. to your formatting will give your numbers column

For Each Cell In Rng2
        Select Case Cell.Value
        Case vbNullString
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
        Case Is > 120
            Cell.Interior.ColorIndex = 3
            Cell.Font.Bold = True
            Cell.Offset(0, 5).Value = 120
        Case Is > 90
            Cell.Interior.ColorIndex = 36
            Cell.Font.Bold = True
            Cell.Offset(0, 5).Value = 90
      Case Is > 60
            Cell.Interior.ColorIndex = 35
            Cell.Font.Bold = True
            Cell.Offset(0, 5).Value = 60
        Case Is > 30
            Cell.Interior.ColorIndex = 6
            Cell.Font.Bold = True
            Cell.Offset(0, 5).Value = 30
        Case Else
            Cell.Interior.ColorIndex = xlNone
            Cell.Font.Bold = False
            Cell.Offset(0, 5).Value = "-"
        End Select
    Next