Anyone Help me Turn these formulas into VBA ?

[mercmannick]

:banghead:

I have Posted on Mr Excel ........

http://www.mrexcel.com/board2/viewtopic.php?t=205283

as i cant attach sheet there, and was hoping Cross post maybe better on this
Many Thanks

Merc

[Bob Phillips]

Do you want a UDF



Function CheckDate(ScheduleDate, StartDate, PlanDate, ForecastDate, ActualDate)
Select Case True
Case ScheduleDate = ActualDate And _
ScheduleDate = StartDate: CheckDate = "AR"
Case ScheduleDate = PlanDate And _
ScheduleDate = StartDate: CheckDate = "PR"
Case ScheduleDate = ForecastDate And _
ScheduleDate = ActualDate: CheckDate = "AF"
Case ScheduleDate = StartDate: CheckDate = "R"
Case ScheduleDate = ActualDate: CheckDate = "A"
Case ScheduleDate = ForecastDate: CheckDate = "F"
Case ScheduleDate = PlanDate: CheckDate = "P"
Case Else: CheckDate = ""
End Select
End Function


Use like

=CheckDate(V$2,$A5,$E5,$F5,$G5)

[mercmannick]

Xld

im not to sure , have you looked at the s sheet ?

looks like the theory is right , ( but im not sure how to implement this) can you advise a little

Thanks

Merc

[mercmannick]

Xld

excellent m8 works a dream, all i need to do now is sort a code out for cond format based on ..............

the range in s/sheet

anyone give me a start

Regards

Merc

[mercmannick]

Cond Format to be like

if cell is "A" then green fill and bold black text

if cell is "R" then red fill and bold white text

if cell is "P" orange fill and bold white text

if cell is "F" blue fill and bold white text

if cell is "AR" then green fill and bold black text

if cell is "PR" orange fill and bold white text

if cell is "AF" then green fill and bold black text


And so on


Merc

[matthewspatrick]

You'll need to use the worksheet's calculate event--CF only gives you three conditions...

[mercmannick]

You'll need to use the worksheet's calculate event--CF only gives you three conditions...
patric

like how ...

can you give me an example


Merc

[geekgirlau]

You'll need to name the range that you want to check as "rngDate", otherwise your code will have to check the entire sheet.


Private Sub Worksheet_Calculate()
Dim rng As Range

' only check the range named "rngDate"
For Each rng In Range("rngDate")
Select Case rng.Value
Case "A", "AF", "AR"
With rng
.Interior.ColorIndex = 43
.Font.Bold = True
.Font.ColorIndex = 0
End With
Case "R"
With rng
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "P", "PR"
With rng
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "F"
With rng
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2
End With

' clear formatting for any other value
Case Else
With rng
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
End Select
Next rng
End Sub

[mercmannick]

geekgirlau

i will test now but , i have tryed a select case and because the range is so large L6:GZ1279 , it takes forever to run for some reason, but i will definately try

Regards

Merc

[mercmannick]

geekgirlau

it works a treat but taking at least 10 mins to calculate :(

Merc

[mercmannick]

is there any way of if a Cell, in Column C,D,H,I,J is changed then update that row only, instead of updating whole range everytime

Just a thought not sure if possible ?

Merc

[mercmannick]

Just thought as this is a shared sheet on a network drive, the function i have above ,will not work unless they all have this udf installed on there pc's

Can i embed this function into this sheet, as i know a lot of the people who will share it will, not be upto installing a function.


Merc

[XLGibbs]

YOu can place the function in a standard module in the same workbook and other's can use it provided they enable macros. If it is in your PERSONAL.xls workbook, it will only work on your PC.

[mercmannick]

YOu can place the function in a standard module in the same workbook and other's can use it provided they enable macros. If it is in your PERSONAL.xls workbook, it will only work on your PC.

M8 how would i do this , just set the function as a sub ?

Merc

[Bob Phillips]

M8 how would i do this , just set the function as a sub ?

Merc

He is saying put the function in a standard code module witjin the shared workbook, the workbook that will use it.

[mercmannick]

Xld

this solution i have from posters is workin but it is takin so longto calculate , i think i am going to have to start from scratch , and try another way

Merc

[mercmannick]

Private Sub Worksheet_Calculate()
Dim rng As Range

' only check the range named "rngDate"
For Each rng In Range("rngDate")
Select Case rng.Value
Case "A", "AF", "AR"
With rng
.Interior.ColorIndex = 43
.Font.Bold = True
.Font.ColorIndex = 0
End With
Case "R"
With rng
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "P", "PR"
With rng
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "F"
With rng
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2
End With

' clear formatting for any other value
Case Else
With rng
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
End Select
Next rng
End Sub


is there any way of making this only look at cells that have a value and not every cell in its range

Merc

[Bob Phillips]

Xld

this solution i have from posters is workin but it is takin so longto calculate , i think i am going to have to start from scratch , and try another way

Merc

Merc,

If that code is taking a long time, the range must be very large. Have you used a named range as shown, and have you reduced it to the barest minimum of cells?

The main problem is that it fires every time a cell changes that triggers calculate, so you need to identify some less intensive action that could trigger the re-painting of the cell colours.

[mercmannick]

Private Sub Worksheet_Calculate()
Dim rng As Range

' only check the range named "rngDate"
For Each rng In Range("rngDate")
Select Case rng.Value
Case "A", "AF", "AR"
With rng
.Interior.ColorIndex = 43
.Font.Bold = True
.Font.ColorIndex = 0
End With
Case "R"
With rng
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "P", "PR"
With rng
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "F"
With rng
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2
End With

' clear formatting for any other value
Case Else
With rng
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
End Select
Next rng
End Sub


is there any way of making this only look at cells that have a value and not every cell in its range
as the actual rngDate is $L3:$FB1038
Merc

[mercmannick]

Xld

as the actual rngDate is $L3:$FB1038

im not sure how i can reduce this, is there anyway of it updating only cells that change ? im not sure if this is possible

Merc

[Bob Phillips]

Xld

as the actual rngDate is $L3:$FB1038

im not sure how i can reduce this, is there anyway of it updating only cells that change ? im not sure if this is possible

Merc

Yes, just use the Worksheet_Change event. Problem with that is if the cells being monitored take their value from another cell via a formula, when the other cell changes, it won't trigger the change event and thus the colour will not change.

[mercmannick]

trying this as well but taking so long to update , is there any other way round my solution ?

Merc

[Bob Phillips]

If you are now using the Change event, you need to change the code to process just the single cell, not them all


Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range

' only check the range named "rngDate"
If Not Intersect(Target, Range("rngDate")) Is Nothing Then
With Target
Select Case .Value

Case "A", "AF", "AR"
.Interior.ColorIndex = 43
.Font.Bold = True
.Font.ColorIndex = 0

Case "R"
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2

Case "P", "PR"
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2

Case "F"
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2

' clear formatting for any other value
Case Else
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False

End Select
End With
End If
End Sub

[mercmannick]

how will this be done m8

Merc

[Bob Phillips]

how will this be done m8

Merc

Don't understand the question.

[mercmannick]

If you are now using the Change event, you need to change the code to process just the single cell, not them all

this xld

[Bob Phillips]

this xld

I gave you that code in the same response.

[mercmannick]

Xld

can i send you sample book to check , plz
as i dont think i am explaining my problem properly.

Merc

[geekgirlau]

What format is your attachment in? RAR? Couldn't open the file!

However if you paste xld's code as is, it should work.

[lucas]

Its rar compressed and then zipped. almost 5mb as an excel file.

[mercmannick]

geekgirl, or anyone

xld code does work but it is taking 10mins to update evrytime ,is there a way of telling that code only to update active row of range , instead of all the range ?


Merc

[Bob Phillips]

That is what my code does. This line


If Not Intersect(Target, Range("rngDate")) Is Nothing Then


checks a single cell update being within the target range.

[mercmannick]

Xld

if its only checking single cell , it should be instant, but this is taking about 10 mins to update

Merc

[Bob Phillips]

Then you need to post an example we can actually read.

[mercmannick]

here is a sample of sheet with code and function, only first 50 rows as its to large otherwise.(just plain zipped)


Merc

[mercmannick]

Sub Change_colours()
Dim rng As Range



' only check the range named "rngDate"
For Each rng In Range("rngDate")

Select Case rng.Value

Case "A", "AF", "AR", "AP"
With rng
.Interior.ColorIndex = 4
.Font.Bold = True
.Font.ColorIndex = 0
End With

Case "R", "RA", "RF", "RP"
With rng
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "P", "PR", "PF", "PA"
With rng
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2
End With


Case "F", "FP", "FR", "FP"
With rng
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2
End With

' clear formatting for any other value
Case Else
With rng
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
End Select
Next rng

End Sub

sample of modified code i tryed using to quicken up

Merc

[mercmannick]

ActiveSheet.Cells(ActiveCell.Row...................................


is there anyway to use something like this in code, rather than whole range evertime ?

Merc

[geekgirlau]

The other way to do it is to look at the precedent cells that set the value in your range "rngDate". Using the Worksheet On Change event, you could check whether one of your precedent cells has been changed, and if so update the format of the related "rngDate" cell.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range


Application.EnableEvents = False
If Intersect(Target, Range("E:E")) Is Nothing And _
Intersect(Target, Range("H:J")) Is Nothing Then
Exit Sub
End If

' only check the nominated row
For Each rng In Intersect(Range(Target.Row & ":" & Target.Row), Range("rngDate"))
Select Case rng.Value
Case "A", "AF", "AR", "AP"
With rng
.Interior.ColorIndex = 4
.Font.Bold = True
.Font.ColorIndex = 0
End With

Case "R", "RA", "RF", "RP"
With rng
.Interior.ColorIndex = 3
.Font.Bold = True
.Font.ColorIndex = 2
End With

Case "P", "PR", "PF", "PA"
With rng
.Interior.ColorIndex = 45
.Font.Bold = True
.Font.ColorIndex = 2
End With


Case "F", "FP", "FR", "FP"
With rng
.Interior.ColorIndex = 5
.Font.Bold = True
.Font.ColorIndex = 2
End With

' clear formatting for any other value
Case Else
With rng
.Interior.ColorIndex = xlNone
.Font.ColorIndex = 0
.Font.Bold = False
End With
End Select
Next rng

Application.EnableEvents = True
End Sub

[mercmannick]

geekgirlau (http://www.vbaexpress.com/forum/member.php?u=450)


it is still taking Ten minutes to update sheet, isnt there a way just to update the cell in rngDate that is updated


Merc

[geekgirlau]

I think you need to step through this and see what cells it's attempting to update. After this line:

For Each rng In Intersect(Range(Target.Row & ":" & Target.Row), Range("rngDate"))

add
Debug.Print rng.Address

If you display the immediate window, it should print out the address of each cell that is being updated so you can track what's going on.