PDA

View Full Version : [SOLVED] Conditional Formatting a row - several conditions



seals
08-25-2005, 04:33 AM
Hi all,

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

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 :eek:) and what I can do?

Any help would be appreciated,

Cheers,

Seals

mdmackillop
08-25-2005, 08:42 AM
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
08-25-2005, 01:34 PM
Why not just add it to the formula?

seals
08-26-2005, 04:08 AM
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.:banghead:

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


Seals

seals
08-26-2005, 04:12 AM
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

:dunno

mdmackillop
08-26-2005, 04:23 AM
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
08-26-2005, 04:49 AM
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
08-26-2005, 12:02 PM
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
08-26-2005, 08:26 PM
mdmackillop,

Yeh, sorry about that it was getting a little late:doh:

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

:beerchug:

mdmackillop
08-27-2005, 02:02 AM
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
08-27-2005, 03:52 AM
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
08-27-2005, 03:56 AM
Hi Seals,
Glad to help.
In thread tools, select Mark Thread Solved.
:beerchug:
:beerchug:
:beerchug:

mdmackillop
08-28-2005, 02:07 AM
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
08-28-2005, 02:11 AM
Truely ledgendary

What more can I say?????

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

:beerchug::beerchug::beerchug::beerchug::beerchug::beerchug::beerchug::beer chug:

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

Seals

mdmackillop
08-28-2005, 02:15 AM
Here it is!

seals
08-28-2005, 02:21 AM
Job is done, and the thread is now marked Solved.

Cheers, I owe you one or two :thumb