i have written a macro which updates a football league chart (dont laugh too hard at my code i'm still learning!) The problem is with the last bit of code which deals with the chart - how do i move the chart from where it appears by default to cell myC (4 rows below the bottom of mynewTable)?
Code:
Sub update()
'
' update Macro
' Macro recorded 13/11/2005 by Chris Smith
'
'
Dim myTable As Range
Dim mynewTable As Range
Dim myResults As Range
Dim mynewResults As Range
Dim mynewResultsH As Range
Dim mynewResultsA As Range
Dim mySheet As Worksheet
Dim mynewSheet As Worksheet
Dim myWorkbook As Workbook
Dim sCount As Integer
Set myWorkbook = ActiveWorkbook
sCount = Worksheets.Count
Set mySheet = myWorkbook.Worksheets(sCount - 1)
Set mynewSheet = myWorkbook.Worksheets(sCount)
mySheet.Activate
Set myResults = Range("A1").Offset(4).CurrentRegion
myResults.Activate
Set myTable = myResults.Offset(myResults.Rows.Count + 4).CurrentRegion
myTable.Activate
mynewSheet.Activate
Set mynewResults = mynewSheet.Range("A1").Offset(4).CurrentRegion
Set mynewResultsH = mynewResults.Offset(1, 1).Resize(mynewResults.Rows.Count - 1, 4)
Set mynewResultsA = mynewResults.Offset(1, 5).Resize(mynewResults.Rows.Count - 1, 4)
mynewResultsH.Activate
mynewResultsA.Activate
mynewResults.Activate
Dim r As Range
Set r = mynewResults.Offset(mynewResults.Rows.Count + 4)
r.Select
myTable.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
Set mynewTable = mynewResults.Offset(mynewResults.Rows.Count + 4).CurrentRegion
Range("A1").Select
mynewTable.Range("O1").Activate
Dim myteams As Range
Dim myplayed As Integer
Dim mypoints As Integer
Dim myfor As Integer
Dim myagainst As Integer
Dim mywon As Integer
Dim mydrawn As Integer
Dim mylost As Integer
Dim mygd As Integer
Dim myplayedA As Integer
Dim mypointsA As Integer
Dim myforA As Integer
Dim myagainstA As Integer
Dim mywonA As Integer
Dim mydrawnA As Integer
Dim mylostA As Integer
Dim mygdA As Integer
Set myteams = mynewTable.Offset(2, 0).Resize(mynewTable.Rows.Count - 2, mynewTable.Columns.Count - 13)
myteams.Activate
For Each myteams In myteams
Set C = mynewResultsH.Find(myteams, lookat:=xlWhole)
If Not C Is Nothing Then
With C
myfor = C.Offset(0, 1)
myagainst = C.Offset(0, 5)
mygd = myfor - myagainst
If myfor > myagainst Then
mywon = 1
mypoints = 3
myplayed = 1
End If
If myfor < myagainst Then
mylost = 1
myplayed = 1
End If
If myfor = myagainst Then
mydrawn = 1
mypoints = 1
myplayed = 1
End If
End With
End If
Set C = myteams.Find(myteams, lookat:=xlWhole)
If Not C Is Nothing Then
With C
C.Offset(0, 1) = C.Offset(0, 1) + myplayed
C.Offset(0, 2) = C.Offset(0, 2) + mywon
C.Offset(0, 3) = C.Offset(0, 3) + mydrawn
C.Offset(0, 4) = C.Offset(0, 4) + mylost
C.Offset(0, 5) = C.Offset(0, 5) + myfor
C.Offset(0, 6) = C.Offset(0, 6) + myagainst
C.Offset(0, 12) = C.Offset(0, 5) + C.Offset(0, 10) - C.Offset(0, 6) - C.Offset(0, 11)
C.Offset(0, 13) = C.Offset(0, 13) + mypoints
myplayed = 0
mywon = 0
mydrawn = 0
mylost = 0
myfor = 0
myagainst = 0
mypoints = 0
End With
End If
Set C = mynewResultsA.Find(myteams, lookat:=xlWhole)
If Not C Is Nothing Then
With C
myforA = C.Offset(0, 1)
myagainstA = C.Offset(0, -1)
If myforA > myagainstA Then
mywonA = 1
mypointsA = 3
myplayedA = 1
End If
If myforA < myagainstA Then
mylostA = 1
myplayedA = 1
End If
If myforA = myagainstA Then
mydrawnA = 1
mypointsA = 1
myplayedA = 1
End If
End With
End If
Set C = myteams.Find(myteams, lookat:=xlWhole)
If Not C Is Nothing Then
With C
C.Offset(0, 1) = C.Offset(0, 1) + myplayedA
C.Offset(0, 7) = C.Offset(0, 7) + mywonA
C.Offset(0, 8) = C.Offset(0, 8) + mydrawnA
C.Offset(0, 9) = C.Offset(0, 9) + mylostA
C.Offset(0, 10) = C.Offset(0, 10) + myforA
C.Offset(0, 11) = C.Offset(0, 11) + myagainstA
C.Offset(0, 12) = C.Offset(0, 5) + C.Offset(0, 10) - C.Offset(0, 6) - C.Offset(0, 11)
C.Offset(0, 13) = C.Offset(0, 13) + mypointsA
myplayedA = 0
mywonA = 0
mydrawnA = 0
mylostA = 0
myforA = 0
myagainstA = 0
mypointsA = 0
mygdA = 0
End With
End If
Next myteams
Dim goalsScored As Range
Set goalsScored = mynewTable.Offset(2, 14).Resize(mynewTable.Rows.Count - 2, mynewTable.Columns.Count - 13)
goalsScored.Activate
Dim d As Integer
For Each goalsScored In goalsScored
d = goalsScored.Offset(0, -4) + goalsScored.Offset(0, -9)
goalsScored = d
Next goalsScored
Dim f As Range
Set f = mynewTable.Offset(2, 0).Resize(mynewTable.Rows.Count - 2, mynewTable.Columns.Count + 1)
f.Select
f.Range("N1").Activate
Selection.sort Key1:=Range("N2"), Order1:=xlDescending, Key2:=Range( _
"M2"), Order2:=xlDescending, Key3:=Range("O2"), Order3:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
mynewSheet.Range("O:O").Select
Selection.ClearContents
Dim lp As Range
Set lp = mynewTable.Offset(-2, 0).Resize(1, 1)
lp.Select
ActiveCell.FormulaR1C1 = "League Position"
With ActiveCell.Characters(Start:=1, Length:=15).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1").Select
Dim mynewTablec As Range
Set mynewSheet = ActiveSheet
Set mynewTablec = Union(f.Columns("A"), f.Columns("F"), f.Columns("K"))
mynewTablec.Activate
Charts.Add
ActiveChart.ChartType = xlColumnStacked
ActiveChart.Location Where:=xlLocationAsObject, Name:=mynewSheet.Name
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Goals scored by all teams"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Goals scored"
End With
With ActiveChart
.HasAxis(xlCategory, xlPrimary) = True
.HasAxis(xlValue, xlPrimary) = True
End With
ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
ActiveChart.HasLegend = True
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.HasDataTable = False
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.TickLabelSpacing = 1
.TickMarkSpacing = 1
.AxisBetweenCategories = True
.ReversePlotOrder = False
End With
With Selection.TickLabels
.Alignment = xlCenter
.Offset = 100
.ReadingOrder = xlContext
.Orientation = xlUpward
End With
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScale = 15
.MinorUnit = 1
.MajorUnit = 5
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
ActiveChart.ChartArea.Select
Dim myC As Range
Set myC = mynewTable.Offset(25, 0).Resize(1, 1)
myC.Activate
End Sub
