B
Breck
This code works in Excel 2007 but the section 'To update user value
for CrossesAt doesn't work in Excel 2003 run time error '1004' unable
to get ChartObjects of the worksheet class is displayed. What changes
need to be made to get this code to work in Excel 2003. If the code
could be modified to the change the crosses at value only if the user
has change the field on row 20 would be perfect but I just started
learning VBA the last couple of months and haven't figured how how yet
Private Sub worksheet_activate()
Application.ScreenUpdating = False
'In case sheets are grouped
Sheet4.Select
On Error GoTo Ungroup
'To Unprotect this sheet if protected
If Me.ProtectContents = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Else
End If
'To Update user value for CrossesAt value
With ActiveSheet
If .ChartObjects("Chart 1").Chart.Axes(xlValue).CrossesAt
<> .Range("I20") Then
.ChartObjects("Chart 1").Chart.Axes(xlValue).CrossesAt
= .Range("I20")
End If
If .ChartObjects("Chart 2").Chart.Axes(xlValue).CrossesAt
<> .Range("J20") Then
.ChartObjects("Chart 2").Chart.Axes(xlValue).CrossesAt
= .Range("J20")
End If
If .ChartObjects("Chart 3").Chart.Axes(xlValue).CrossesAt
<> .Range("K20") Then
.ChartObjects("Chart 3").Chart.Axes(xlValue).CrossesAt
= .Range("K20")
End If
If .ChartObjects("Chart 4").Chart.Axes(xlValue).CrossesAt
<> .Range("P20") Then
.ChartObjects("Chart 4").Chart.Axes(xlValue).CrossesAt
= .Range("P20")
End If
If .ChartObjects("Chart 5").Chart.Axes(xlValue).CrossesAt
<> .Range("Q20") Then
.ChartObjects("Chart 5").Chart.Axes(xlValue).CrossesAt
= .Range("Q20")
End If
If .ChartObjects("Chart 6").Chart.Axes(xlValue).CrossesAt
<> .Range("R20") Then
.ChartObjects("Chart 6").Chart.Axes(xlValue).CrossesAt
= .Range("R20")
End If
If .ChartObjects("Chart 7").Chart.Axes(xlValue).CrossesAt
<> .Range("S20") Then
.ChartObjects("Chart 7").Chart.Axes(xlValue).CrossesAt
= .Range("S20")
End If
If .ChartObjects("Chart 8").Chart.Axes(xlValue).CrossesAt
<> .Range("Z20") Then
.ChartObjects("Chart 8").Chart.Axes(xlValue).CrossesAt
= .Range("Z20")
End If
If .ChartObjects("Chart 9").Chart.Axes(xlValue).CrossesAt
<> .Range("AA20") Then
.ChartObjects("Chart 9").Chart.Axes(xlValue).CrossesAt
= .Range("AA20")
End If
End With
'This hides all rows with zero values
Range("AI1:AI262").AutoFilter Field:=1, Criteria1:="<>0"
'This resets protection
If Me.ProtectContents = False Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True, AllowFormattingColumns:=True, AllowFiltering:=True
Else
ActiveSheet.Unprotect
End If
On Error GoTo 0
'The macro is done. Use Exit sub, otherwise the macro
'execution WILL continue into the error handler
Exit Sub
Ungroup:
MsgBox "Please ungroup sheets"
End Sub
for CrossesAt doesn't work in Excel 2003 run time error '1004' unable
to get ChartObjects of the worksheet class is displayed. What changes
need to be made to get this code to work in Excel 2003. If the code
could be modified to the change the crosses at value only if the user
has change the field on row 20 would be perfect but I just started
learning VBA the last couple of months and haven't figured how how yet
Private Sub worksheet_activate()
Application.ScreenUpdating = False
'In case sheets are grouped
Sheet4.Select
On Error GoTo Ungroup
'To Unprotect this sheet if protected
If Me.ProtectContents = True Then
ActiveSheet.Select
ActiveSheet.Unprotect
Else
End If
'To Update user value for CrossesAt value
With ActiveSheet
If .ChartObjects("Chart 1").Chart.Axes(xlValue).CrossesAt
<> .Range("I20") Then
.ChartObjects("Chart 1").Chart.Axes(xlValue).CrossesAt
= .Range("I20")
End If
If .ChartObjects("Chart 2").Chart.Axes(xlValue).CrossesAt
<> .Range("J20") Then
.ChartObjects("Chart 2").Chart.Axes(xlValue).CrossesAt
= .Range("J20")
End If
If .ChartObjects("Chart 3").Chart.Axes(xlValue).CrossesAt
<> .Range("K20") Then
.ChartObjects("Chart 3").Chart.Axes(xlValue).CrossesAt
= .Range("K20")
End If
If .ChartObjects("Chart 4").Chart.Axes(xlValue).CrossesAt
<> .Range("P20") Then
.ChartObjects("Chart 4").Chart.Axes(xlValue).CrossesAt
= .Range("P20")
End If
If .ChartObjects("Chart 5").Chart.Axes(xlValue).CrossesAt
<> .Range("Q20") Then
.ChartObjects("Chart 5").Chart.Axes(xlValue).CrossesAt
= .Range("Q20")
End If
If .ChartObjects("Chart 6").Chart.Axes(xlValue).CrossesAt
<> .Range("R20") Then
.ChartObjects("Chart 6").Chart.Axes(xlValue).CrossesAt
= .Range("R20")
End If
If .ChartObjects("Chart 7").Chart.Axes(xlValue).CrossesAt
<> .Range("S20") Then
.ChartObjects("Chart 7").Chart.Axes(xlValue).CrossesAt
= .Range("S20")
End If
If .ChartObjects("Chart 8").Chart.Axes(xlValue).CrossesAt
<> .Range("Z20") Then
.ChartObjects("Chart 8").Chart.Axes(xlValue).CrossesAt
= .Range("Z20")
End If
If .ChartObjects("Chart 9").Chart.Axes(xlValue).CrossesAt
<> .Range("AA20") Then
.ChartObjects("Chart 9").Chart.Axes(xlValue).CrossesAt
= .Range("AA20")
End If
End With
'This hides all rows with zero values
Range("AI1:AI262").AutoFilter Field:=1, Criteria1:="<>0"
'This resets protection
If Me.ProtectContents = False Then
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True, AllowFormattingColumns:=True, AllowFiltering:=True
Else
ActiveSheet.Unprotect
End If
On Error GoTo 0
'The macro is done. Use Exit sub, otherwise the macro
'execution WILL continue into the error handler
Exit Sub
Ungroup:
MsgBox "Please ungroup sheets"
End Sub