Have I this code that executes on open and updates all worksheets, I don't
want to update the Worksheets that have a STARTDATE greater 01/01/2007 (Cell
D2).

thanks in advance

Private Sub Workbook_Open()
Dim MyItem As Double, MyItem2 As Double, MyItem3 As Double, sh As
Worksheet, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
If IsEmpty(Range("D3").Value) Then
MyItem = Month(Now) / 12 * Range("G4").Value
Else
MyItem = (Month(Range("D3").Value) - Month(Range("b3").Value) + 1)
/ 12 * Range("G4").Value
End If
Range("G8").Value = MyItem
If IsEmpty(Range("D3").Value) Then
MyItem2 = Month(Now) / 12 * Range("G5").Value
Else
MyItem2 = (Month(Range("D3").Value) - Month(Range("b3").Value) +
1) / 12 * Range("G5").Value
End If
Range("G13").Value = MyItem2
If IsEmpty(Range("D3").Value) Then
MyItem3 = Year(Now) - Year(Range("B1"))
Else
MyItem3 = Year(Range("B1")) - Year(Range("D3"))
End If

Next ws
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
sh.OLEObjects("label1").Visible = sh.Range("D3").Value < ""
Next sh
End Sub

One way:

Private Sub Workbook_Open()
Const dtSTARTDATE = #1/1/2007#
Dim dTemp As Double
Dim MyItem As Double
Dim MyItem2 As Double
Dim MyItem3 As Double
Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
With ws
If .Range("D2").Value dtSTARTDATE Then
If IsEmpty(.Range("D3").Value) Then
dTemp = Month(Date) / 12
MyItem = dTemp * .Range("G4").Value
MyItem2 = dTemp * .Range("G5").Value
MyItem3 = Year(Date) - Year(Range("B1").Value)
Else
dTemp = (Month(.Range("D3").Value) - _
Month(.Range("B3").Value) + 1) / 12
MyItem = dTemp * .Range("G4").Value
MyItem2 = dTemp * .Range("G5").Value
MyItem3 = Year(Range("B1").Value) - _
Year(Range("D3").Value)
End If
.Range("G8").Value = MyItem
.Range("G13").Value = MyItem2
.OLEObjects("label1").Visible = _
(.Range("D3").Value < vbNullString)
End If
End With
Next ws
End Sub

Note that MyItem3 doesn't get used, even though it's calculated...

In article ,
O.... wrote:

Have I this code that executes on open and updates all worksheets, I don't
want to update the Worksheets that have a STARTDATE greater 01/01/2007 (Cell
D2).

thanks in advance

Private Sub Workbook_Open()
Dim MyItem As Double, MyItem2 As Double, MyItem3 As Double, sh As
Worksheet, ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
ws.Activate
If IsEmpty(Range("D3").Value) Then
MyItem = Month(Now) / 12 * Range("G4").Value
Else
MyItem = (Month(Range("D3").Value) - Month(Range("b3").Value) + 1)
/ 12 * Range("G4").Value
End If
Range("G8").Value = MyItem
If IsEmpty(Range("D3").Value) Then
MyItem2 = Month(Now) / 12 * Range("G5").Value
Else
MyItem2 = (Month(Range("D3").Value) - Month(Range("b3").Value) +
1) / 12 * Range("G5").Value
End If
Range("G13").Value = MyItem2
If IsEmpty(Range("D3").Value) Then
MyItem3 = Year(Now) - Year(Range("B1"))
Else
MyItem3 = Year(Range("B1")) - Year(Range("D3"))
End If

Next ws
On Error Resume Next
For Each sh In ActiveWorkbook.Worksheets
sh.OLEObjects("label1").Visible = sh.Range("D3").Value < ""
Next sh
End Sub