request help to combine two similar macros

D

DDawson

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
 
B

Bob Phillips

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)
 
D

DDawson

Thanks Bob,

I wasn't sure about using Application.Calculation = xlCalculationManual with
a Worksheet_Calculate event.

Simple really!

Regards
Dylan
 
D

Dylan

Dear Bob,

unfortunately, I was too quick in responding to this previously.

I now find that when the two macros are combined, the routine goes into a
loop and I have to press escape to cancel it.

It would be nice to have a sheet that constantly updates the values of
Update_CEStatus(). Instead, I have added the Update_CEStatus() to the macro
that imports the latest database info into my workbook. This is the only time
it really needs to be checked and updated.

I look forward to reading any further advice regarding why the two macros
wornt work together as a calculate event.

Dylan
--
 
B

Bob Phillips

As it is a calculate event, probably best not to mess with calculation
status

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

With Application

.ScreenUpdating = False
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
End With
End Sub


--
HTH

Bob

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Convert Macro into UDF 3
Conditional formatting - why doesn't this work? 3
Pass condition formatting across worksheets via vba. 0
For Eachcell in Range tranpose comma seperated values to a list in D 4
Sheet to sheet code Type Mismatch 6
Find string from column A in Range("B2:F7") list the header of that column/s 5
My code need to go on a diet 10
Code not working 3

Top