locating a chart in a worksheet

cjsmith22

New Member
Joined
Nov 2, 2005
Messages
22
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
 

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Watch MrExcel Video

Forum statistics

Threads
1,118,011
Messages
5,569,610
Members
412,282
Latest member
bobHenk
Top