Hi
Still does not work new message is Sub or function not
defined. I normaly just record macros so this is a bid
more of a chalange

Sub Macro1()
'
'
If CheckBoxes(46).Value = True Then
Range("O54").FormulaR1C1 = "50000"
Range("T54").FormulaR1C1 = "4000"
Range("Y54").FormulaR1C1 = "4000"
Range("AD54").FormulaR1C1 = "4000"
Range("AI54").FormulaR1C1 = "4000"
Range("AN54").FormulaR1C1 = "4000"
Range("AS54").FormulaR1C1 = "4000"
Range("AX54").FormulaR1C1 = "4000"
Range("BC54").FormulaR1C1 = "4000"
Range("BH54").FormulaR1C1 = "4000"
Range("O78").FormulaR1C1 = "120000"
ActiveSheet.Shapes.AddShape
(msoShapeRectangularCallout, 629.25, 643.5, 51#, _
30.75).Select
Selection.Characters.Text = "Japan"
With Selection.Characters(Start:=1, Length:=5).Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
Selection.ShapeRange.Adjustments.Item(1) = -0.1618
Selection.ShapeRange.Adjustments.Item(2) = 1.1219
Selection.ShapeRange.ScaleHeight 0.56, msoFalse,
msoScaleFromTopLeft
Range("O77").Select
ActiveWindow.SmallScroll Down:=-60
If CheckBoxes(46).Value = False Then
Range("O78").ClearContents
ActiveSheet.Shapes("AutoShape 44").Select
Selection.Delete
Range("O54:BH54").ClearContents
Range("A5").Select
End Sub