Conditional Formatting a row - several conditions

[seals]

Hi all,

I am wondering if anyone can give me a hand with a bit of code or push in the right direction.

I have an excel sheet that I conditionally formatted using excel conditional format tool with the following formula:

=AND($B616+2<=TODAY(), $B616+4>=TODAY(),$E616="A",
OR(RIGHT($P616,3)="ARA",RIGHT($P616,3)="ARM",RIGHT($P616,3)="AMG",RIGHT($P616,3)="ARD"))

Now this does the job without too many problems however I also want to have a <> null on $N616.

Is there a way to code this into the VBA side?
I have managed to fuddle my way to this piece of code but I can't quite make the leap to the next stage:

Mydate = Date
endDate = Date - 7

For Each cl In Range("H9:H" & [H65536].End(3).Row)
        If cl.Value <= Mydate And cl.Value >= endDate Then cl([1], [1]).Interior.ColorIndex = 13
       Next cl

Obviously I would like the code to loop throught the entire sheet and colour the relevant rows, but I am struggling with it so far. Any ideas on where I can go (Be Nice ) and what I can do?

Any help would be appreciated,

Cheers,

Seals

[mdmackillop]

Hio Seals,
Welcome to VBAX.
I'm not sure if I've got you right, but have a look at the following. It finds dates for the last 7 days in column B, checks for a corresponding value in column P and if found, highlights the row yellow.

Option Explicit
Option Base 1

Sub Test()
Dim MyDates As Range, c As Range, i As Long
Dim ToMatch, Tmp As String, MyStr As String, FirstAddress As String
ToMatch = Array("AMG", "ARA", "ARD", "ARM")
Set MyDates = Range("B1:B" & [B65536].End(3).Row)
'Set range of dates to be found
For i = Int(Now() - 7) To Int(Now())
    With MyDates
        Set c = .Find(i, LookIn:=xlValues)
        If Not c Is Nothing Then
            FirstAddress = c.Address
            Do
                Tmp = 0
                'Check corresponding values in col P
                MyStr = Right(c.Offset(0, 14), 3)
                On Error Resume Next
                Tmp = Application.WorksheetFunction.Match(MyStr, ToMatch, 0)
                If Tmp > 0 Then c.EntireRow.Interior.ColorIndex = 6
                Set c = .FindNext(c)
            Loop While Not c Is Nothing And c.Address <> FirstAddress
        End If
    End With
Next
End Sub

[Bob Phillips]

Why not just add it to the formula?

[seals]

Thank you for your reply,

I think that you nearly got what I am looking at, perhaps let me explain in a slightly different way:

I have a spreadsheet with 500 - 800 rows, 17 Colums.

$B10 will have a date say today,
$E10 will have either and "A", "R" or "ENB"
$H10 will have the "AMG","ARA","ARD" etc
$O10 will have a date accepted
$P10 will have a Where it was sent column

So If $E10 = A and $H10 = "AMG", "ARA" etc and $P10 is NULL then
If $E10 + 2<=NOW() then EntireRow.Interior.ColorIndex = yellow
If $E10 + 4<=NOW() then EntireRow.Interior.ColorIndex = red

Equally for

So If $E10 = "R" and $H10 = "RPA", "RPM" etc and $P10 is NULL then
If $E10 + 14<=NOW() then EntireRow.Interior.ColorIndex = yellow
If $E10 +18<=NOW() then EntireRow.Interior.ColorIndex = red

And again for

So If $E10 = "ENB" and $H10 = "TIN", "CEN" etc and $P10 is NULL then
If $E10 + 3<=NOW() then EntireRow.Interior.ColorIndex = yellow
If $E10 + 5<=NOW() then EntireRow.Interior.ColorIndex = red

And obviously still loops throgh the entire sheet.

I hope that this gives you an idea of where I am trying to head, I have tried nested if statements and case statements but I seem to get all tied up.

Again thankyou for your help thus far, I really do appreciate it


Seals

[seals]

xld,

I was getting all tied up with with direction to best handle the problem, in short my experience level is certainly lacking. I guess just a little nudge in the right direction was what I was seeking.

I still have alot of stuff to tackle with the project, so any help was and would be appreciated.

Seals

[mdmackillop]

Hi Seals,
Can you attach a copy of part of your spreadsheet (confidential stuff removed) with the colouring etc. as you want it. To attach a file, zip it and use the Go Advanced button and Manage Attachments

[seals]

mdmackillop,

I have taken out as much as I can to lessen the size, let me know if I am still confusing you.

I'll be online for about another hour, and again tomorrow (Saturday) and Sunday.

Cheers,

Seals

[mdmackillop]

Hi Seals,
Some of the column data does not appear to tie up with your note, possibly due to some deleted columns. The code should be easily adjusted to correct to your original data. I've added some range names to the Codes sheet, to read in the data to the 3 arrays, this can be hard coded as per my previous code if you prefer. I've set the code to clear previous colours, then resetting each line. If the old colour is to be retained, this would need to be adjusted.

[seals]

mdmackillop,

Yeh, sorry about that it was getting a little late

That is pretty close to what I need, certaininly more help than what I was expecting.

I do have a question (of Course) with the range:

arARA = Range("ARAetc").Value

I am right in assuming that I need to change that to suit the criteria needed eg

arARA = Range("ARA", "ARM", "ARN").Value

or am I not reading that correctly?

Thanks again for your help it really is appreciated

Seals

[mdmackillop]

Hi Seals,
I'm a bit lazy in my typing, hence the shortcut.
You will need to type arARA = Array("ARA", "ARM", "ARN") etc.
My shortcut was to create a range names "ARAetc" etc., which referred to the blocks of text on your Codes Sheet, and create the array as shown. This could be an advantage if flexibility is required.
Any other queries, just ask.

[seals]

mdmackillop,

Once again I thank you for your help, you have helped in more ways than you know. If I can do you a favour at anytime let me know.

Cheers

Seals

P.S is there a way of finalising this thread?

[mdmackillop]

Hi Seals,
Glad to help.
In thread tools, select Mark Thread Solved.

[mdmackillop]

Hi Seals,
Re your PM, here is a sub to print the coloured rows only.

Sub DoPrint()
    Dim Endd As Long, i As Long
    Application.ScreenUpdating = False
    Endd = [B65536].End(xlUp).Row()
    For i = 10 To Endd
        If Cells(i, "B").Interior.ColorIndex = xlNone Then Rows(i).Hidden = True
    Next
    ActiveSheet.PageSetup.PrintArea = "$A$8:$Q$" & Endd
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
    Rows("10:" & Endd).Hidden = False
    Application.ScreenUpdating = True
End Sub

[seals]

Truely ledgendary

What more can I say?????

Thank you again for all of your help, you have been great.



However I still don't know how to close this thread

Seals

[mdmackillop]

Here it is!

[seals]

Job is done, and the thread is now marked Solved.

Cheers, I owe you one or two