|
Subject:
|
Freeforms
|
|
Posted By:
|
kempy316
|
Post Date:
|
9/21/2003 5:24:25 AM
|
I have created a spreadsheet with 30 sheets, sheets 1-20 have freeforms in column G, depending on what I type in column H is changes the color of the freeform in G.
But in sheets 21-30 are input pages, when I go into these pages the code is looking for the freeforms, How can I stop this happening?
Here is the code
Private Sub Worksheet_Calculate()
Dim LOCATION As String
Dim shirt As String
Dim shorts As String
Dim iRowNumber As Integer
Dim iShapeNo As Integer
If ActiveWindow.Caption <> ThisWorkbook.Name Then GoTo done
ActiveSheet.Protect UserInterfaceOnly:=True
LOCATION = ActiveCell.Address
iShapeNo = 97
iRowNumber = 4
Do Until iShapeNo = 108
sFreeform = "Freeform " & iShapeNo
shirt = Range("H" & iRowNumber).Value
If shirt = "" Then
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoFalse
GoTo shirtEnd
End If
Select Case shirt
Case "Macclesfield Town", "Birmingham City", "Millwall", "Chelsea", "Everton", "Leicester City", "Portsmouth", "Cardiff City"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.Solid
Case "Swansea City", "Port Vale", "Luton Town", "Preston North End", "Bolton", "Fulham", "Leeds United", "Tottenham Hotspur", "Derby County"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.Solid
Case "York City", "Kidderminster Harriers", "Wrexham", "Swindon Town", "Bristol City", "Barnsley", "Walsall", "Nottingham Forest", "Liverpool", "Charlton Athletic", "Manchester United", "Middlesbro", "Crewe"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.Solid
Case "Newcastle United", "Grimsby Town", "Notts County", "Darlington"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Arsenal", "Rotherham United", "Bournemouth"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Blackburn Rovers", "Bristol Rovers"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.RGB = RGB(255, 255, 255)
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 2
Case "Aston Villa", "West Ham United", "Sc**thorpe United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 40
Selection.ShapeRange.Fill.BackColor.SchemeColor = 20
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 3
Case "Southampton"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Manchester City", "Coventry City"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 40
Selection.ShapeRange.Fill.Solid
Case "Wolves", "Boston United", "Cambridge United", "Hull City", "Mansfield Town"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 51
Selection.ShapeRange.Fill.Solid
Case "Reading", "Q.P.R", "Brighton"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkHorizontal
Case "W.B.A"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 32
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Bradford City"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.BackColor.SchemeColor = 25
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Burnley"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 25
Selection.ShapeRange.Fill.Solid
Case "Crystal Palace"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 32
Selection.ShapeRange.Fill.BackColor.SchemeColor = 10
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Gillingham"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.BackColor.SchemeColor = 32
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Ipswich Town", "Stockport County", "Carlisle United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 32
Selection.ShapeRange.Fill.Solid
Case "Norwich City", "Watford"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.Solid
Case "Lincoln City", "Cheltenham Town", "Sheffield United", "Stoke City", "Sunderland", "Brentford"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Wimbledon"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 32
Selection.ShapeRange.Fill.BackColor.SchemeColor = 5
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Blackpool"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 52
Selection.ShapeRange.Fill.Solid
Case "Rochdale", "Chesterfield", "Wigan Athletic", "Oldham Athletic", "Peterborough United", "Rushden"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Colcester United", "Sheffield Wednesday", "Huddersfield Town"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkVertical
Case "Hartlepool United", "Tranmere Rovers", "Bury"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Selection.ShapeRange.Fill.BackColor.SchemeColor = 12
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Plymouth Albion"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Case "Wycombe Wanderers"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 40
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 2
Case "Doncaster Rovers"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkHorizontal
Case "Leyton Orient"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 8
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Northampton Town"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 25
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Oxford United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.BackColor.SchemeColor = 12
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Southend United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 18
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Torquay United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 5
Selection.ShapeRange.Fill.BackColor.SchemeColor = 12
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Yeovil Town"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.Patterned msoPatternDarkHorizontal
End Select
shirtEnd:
iShapeNo = iShapeNo + 1
iRowNumber = iRowNumber + 1
Loop
iShapeNo = 108
iRowNumber = 4
Do Until iShapeNo = 119
sFreeform = "Freeform " & iShapeNo
shorts = Range("H" & iRowNumber).Value
If shorts = "" Then
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoFalse
Selection.ShapeRange.Fill.Visible = msoFalse
GoTo shortsEnd
End If
Select Case shorts
Case "Yeovil Town", "Swansea City", "Kidderminster Harriers", "Cheltenham Town", "Doncaster Rovers", "Carlisle United", "Bristol Rovers", "Bristol City", "Wrexham", "Tranmere Rovers", "Swindon Town", "Bristol City", "Brighton", "Brentford", "Bournemouth", "Barnsley", "Walsall", "Stoke City", "Sunderland", "Sheffield United", "Rotherham United", "Nottingham Forest", "Arsenal", "Millwall", "Ipswich Town", "Aston Villa", "Birmingham City", "Crewe", "Blackburn Rovers", "Bolton", "Charlton Athletic", "Everton", "Leeds United", "Leicester City", "Manchester City", "Manchester United", "Portsmouth", "Q.P.R", "Cardiff City", "Reading"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9
Case "Lincoln City", "Hull City", "Darlington", "Cambridge United", "Sheffield Wednesday", "Port Vale", "Luton Town", "Grimsby Town", "Notts County", "Blackpool", "Fulham", "Newcastle United", "Southampton", "Wolves", "Derby County", "Gillingham"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8
Case "Liverpool", "Middlesbro", "Watford"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Case "York City", "Torquay United", "Rochdale", "Macclesfield Town", "Mansfield Town", "Huddersfield Town", "Rushden", "Peterborough United", "Oldham Athletic", "Chelsea", "Wigan Athletic", "Chesterfield", "Colcester United", "Hartlepool United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Case "Southend United", "Wycombe Wanderers", "Tottenham Hotspur", "W.B.A", "Crystal Palace", "Preston North End", "Stockport County"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 18
Case "Bradford City"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 25
Case "Burnley", "Coventry City", "West Ham United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 40
Selection.ShapeRange.Fill.Solid
Case "Norwich City", "Plymouth Albion"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Case "Wimbledon"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 32
Selection.ShapeRange.Fill.BackColor.SchemeColor = 5
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Boston United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.Solid
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 51
Case "Bury"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Leyton Orient"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
Selection.ShapeRange.Fill.BackColor.SchemeColor = 8
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Northampton Town"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 25
Selection.ShapeRange.Fill.BackColor.SchemeColor = 9
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Oxford United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 12
Selection.ShapeRange.Fill.BackColor.SchemeColor = 5
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
Case "Sc**thorpe United"
ActiveSheet.Shapes(sFreeform).Select
Selection.ShapeRange.Line.Visible = msoTrue
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 1
Selection.ShapeRange.Fill.BackColor.SchemeColor = 12
Selection.ShapeRange.Fill.TwoColorGradient msoGradientVertical, 4
End Select
shortsEnd:
iShapeNo = iShapeNo + 1
iRowNumber = iRowNumber + 1
Loop
ActiveCell.Select
done:
End Sub
|
|
Reply By:
|
Kieran
|
Reply Date:
|
9/21/2003 11:26:51 PM
|
activecell.parent.name will give you the name of the worksheet that you are entering data on. You could use this value to exit the change routine if you are not entering data on sheets 1-20.
Hope it helps
Kieran
|
|
