Problem with creating columncharts due to excel 2007 macrorecorder

[bart214]

Lately I have been making macro's with the macrorecorder in excel and everything works fine except for the charting. Apperently the macrorecorder in 2007 is not able to create and adjust new shapes. Unfortunately I need to have a columnchart as some kind of summary at the end of my macro, but since I am not familiar with VBA I was hoping someone here could help me.

The columchart should take its data from a small table, here all the interesting data is gathered. The adjust I want to make to this chart are: position and size(B17:I36), adding datalabels, adjusting gridlines to light grey and coloring of the individual columns. The code that I have in Microsoft Visual Basic is the following:

Range("B3:B15,D3:D15").Select
Range("D3").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.SetSourceData Source:=Range( _
"'Sheet2'!$B$3:$B$15;'Sheet2'!$D$3:$D$15")
ActiveChart.ChartType = xlColumnClustered
Range("G13:N28").Select
Selection.Cut Destination:=Range("B17:I32")
Range("B17:I32").Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Name = "=""SF"""
ActiveChart.SetElement (msoElementDataLabelOutSideEnd)
ActiveChart.Axes(xlValue).HasMajorGridlines = True
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlValue).MajorGridlines.Select

ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection(1).Points(13).Select
ActiveWindow.SmallScroll Down:=9
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(12).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(11).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(10).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(9).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(8).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(7).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(6).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(5).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(4).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(3).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(2).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(1).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.LegendEntries(4).Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Legend.Select
Selection.Position = xlCorner

Hopefully someone can help me with this since I have no idea how to write this in VBA.

 

[Andrew Poulsom]

There is a lot of unnecessary code there. That said, where do you want the Data Labels and what colours do you want for the columns? And why are you cutting G13:N28 to B17:I32?

 

[bart214]

Yeah I thought that might be the case. But since I do not know VBA, it seemed safest to just give all the "information" i have. The cutting and pasting is a beginners solution to place the chart. The datalabels on the end of the column and the coloring of the columns: the first 6 red, one black and the last 6 green.

 

[Andrew Poulsom]

Try:

Sub Test()
    Dim Sh As Worksheet
    Dim Cht As Chart
    Dim Pt As Long
    Set Sh = ActiveSheet
    With Sh.Range("B17:I32")
        Set Cht = .Parent.Shapes.AddChart(xlColumnClustered, .Left, .Top, .Width, .Height).Chart
    End With
    With Cht
        .SetSourceData Source:=Sh.Range("B3:B15,D3:D15")
        .SeriesCollection(1).Name = "SF"
        .SetElement (msoElementDataLabelOutSideEnd)
        With .Axes(xlValue).MajorGridlines.Format.Line
            .Visible = msoTrue
            .ForeColor.RGB = RGB(211, 211, 211)
            .Transparency = 0
        End With
        For Pt = 1 To 6
            With .SeriesCollection(1).Points(Pt).Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(255, 0, 0)
                .Transparency = 0
                .Solid
            End With
        Next Pt
        With .SeriesCollection(1).Points(7).Format.Fill
            .Visible = msoTrue
            .ForeColor.RGB = RGB(0, 0, 0)
            .Transparency = 0
            .Solid
        End With
        For Pt = 8 To 13
            With .SeriesCollection(1).Points(Pt).Format.Fill
                .Visible = msoTrue
                .ForeColor.RGB = RGB(0, 255, 0)
                .Transparency = 0
                .Solid
            End With
        Next Pt
    End With
End Sub

 

[bart214]

It works, thank you very much!