View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips Bob Phillips is offline
external usenet poster
 
Posts: 10,593
Default request help to combine two similar macros

Isn't it simply

Private Sub Worksheet_Calculate()
Dim myC1 As Range
Dim WatchRange1 As Range

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

On Error Resume Next
Set WatchRange1 = Range("AwardValue")
For Each myC1 In WatchRange1

If myC1.Cells.Value = "" Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0
ElseIf myC1.Offset(0, 1).Value = "" Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0
ElseIf myC1.Cells.Value < myC1.Offset(0, 1).Value Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 3 'red
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 3 'red
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 36 'yellow
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 36 'yellow
Else
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0

'0 Blank/Black
'3 Red
'36 Yellow
'15 Grey
'34 Light blue
'16 Dark grey
'
End If

Next myC1

Dim myC2 As Range
Dim WatchRange2 As Range

Set WatchRange2 = Range("Status")
For Each myC2 In WatchRange2
If myC2.Cells.Value = "" _
Or myC2.Cells.Value = "Awaiting Payment" _
Or myC2.Cells.Value = "Awaiting Programme" _
Or myC2.Cells.Value = "Awaiting Construction" _
Or myC2.Cells.Value = "Cancelled" Then
myC2.Offset(0, 1).Value = "Complete"

ElseIf myC2.Cells.Value = "Forecast" _
Or myC2.Cells.Value = "Awaiting Quote" _
Or myC2.Cells.Value = "Awaiting Design" _
Or myC2.Cells.Value = "Awaiting Acceptance" Then
myC2.Offset(0, 1).Value = "Ongoing"

End If
Next myC2

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"DDawson" wrote in message
...
I have two similar macros, one is a conditional formatting macro which
applies colour highlighting to specific rows; the other macro checks a
cell
value and updates the vale of the adjacent cell accordingly.

Is there a way to combine then into one worksheet calculate event?

Private Sub Worksheet_Calculate()
Dim myC1 As Range
Dim WatchRange1 As Range

Application.ScreenUpdating = False
Set WatchRange1 = Range("AwardValue")

On Error Resume Next
For Each myC1 In WatchRange1

If myC1.Cells.Value = "" Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0
ElseIf myC1.Offset(0, 1).Value = "" Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0
ElseIf myC1.Cells.Value < myC1.Offset(0, 1).Value Then
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 3 'red
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 3 'red
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 36 'yellow
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 36 'yellow
Else
Range(myC1, myC1.Offset(0, -7)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Font.ColorIndex = 0
Range(myC1, myC1.Offset(0, -7)).Interior.ColorIndex = 0
Range(myC1, myC1.Offset(0, 5)).Interior.ColorIndex = 0

'0 Blank/Black
'3 Red
'36 Yellow
'15 Grey
'34 Light blue
'16 Dark grey
'
End If

Next myC1


Application.ScreenUpdating = True
End Sub

'----------------------------------------------------------------------------------

Sub Update_CEStatus()

Dim myC2 As Range
Dim WatchRange2 As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
Set WatchRange2 = Range("Status")
'On Error Resume Next

For Each myC2 In WatchRange2
If myC2.Cells.Value = "" _
Or myC2.Cells.Value = "Awaiting Payment" _
Or myC2.Cells.Value = "Awaiting Programme" _
Or myC2.Cells.Value = "Awaiting Construction" _
Or myC2.Cells.Value = "Cancelled" Then
myC2.Offset(0, 1).Value = "Complete"

ElseIf myC2.Cells.Value = "Forecast" _
Or myC2.Cells.Value = "Awaiting Quote" _
Or myC2.Cells.Value = "Awaiting Design" _
Or myC2.Cells.Value = "Awaiting Acceptance" _
myC2.Offset(0, 1).Value = "Ongoing"

End If
Next myC2

With Application
.ScreenUpdating = False
.Calculation = xlCalculationAutomatic
End With
End Sub