Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > request help to combine two similar macros
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 59
Default request help to combine two similar macros
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

Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
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



Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 59
Default request help to combine two similar macros
Thanks Bob,

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

Simple really!

Regards
Dylan

"Bob Phillips" wrote:

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




Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 26
Default request help to combine two similar macros
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
--

"DDawson" wrote:

Thanks Bob,

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

Simple really!

Regards
Dylan

"Bob Phillips" wrote:

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




Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 10,593
Default request help to combine two similar macros
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)

"Dylan" wrote in message
...
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
--

"DDawson" wrote:

Thanks Bob,

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

Simple really!

Regards
Dylan

"Bob Phillips" wrote:

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






Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Linear Mode Linear Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
Combine Two Similar Arrays Rob Excel Worksheet Functions 1 November 17th 09 09:31 PM
How to combine data from 100 similar Excel files Satish Excel Discussion (Misc queries) 2 November 6th 08 03:04 PM
Help 2nd request (sumif formula of similar 17-04-08) Joco Excel Discussion (Misc queries) 2 April 20th 08 01:56 PM
How do I combine quantities of similar line items Joshua Hullender Excel Discussion (Misc queries) 2 January 3rd 06 11:42 PM
Find similar lines and combine Scott Wagner Excel Programming 1 December 30th 05 12:23 AM


All times are GMT +1. The time now is 10:32 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement