Wrox Programmer Forums
|
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
 
Old September 21st, 2003, 05:24 AM
Registered User
  
Join Date: Sep 2003
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Freeforms
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
 
Old September 21st, 2003, 11:26 PM
Registered User
  
Join Date: Aug 2003
Posts: 7
Thanks: 0
Thanked 0 Times in 0 Posts
Default
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








Contact Us - Wrox - Privacy Statement - Top

Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.