Looping 3 macros with a different range of cells each time?

[aa123]

I've currently got 3 macros set up to run together.

- The first creates a chart.
- The second renames the chart title.
- The third exports it as a picture and saves it.

All of them reference a cell or, in the case of the chart creation, multiple cells.

I'd like this to loop, going to the cell/s one column below, until it gets to the last defined column.

Any help would be much appreciated.

Here's the code. I bolded and highlighted in red the cell references that I'll want to change with each loop.

Chart creation:

Sub CHARTCREATION()
'
' CHARTCREATION Macro
' Macro recorded 31/08/2011 by
'
'
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheets("Sheet1").Range( _
        "[COLOR=red][B]D44,G44,J44,M44,P44[/B][/COLOR]"), PlotBy:=xlRows
    ActiveChart.SeriesCollection(1).XValues = _
        "=(Sheet1!R42C2,Sheet1!R42C5,Sheet1!R42C8,Sheet1!R42C11,Sheet1!R42C14)"
    ActiveChart.SeriesCollection(1).Name = "=""Conversion Rate"""
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Conversion Rate"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Conversion %"
    End With
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Values = _
        "=(Sheet1!R116C9,Sheet1!R117C9,Sheet1!R118C9,Sheet1!R119C9,Sheet1!R120C9)"
    ActiveChart.SeriesCollection(2).Name = "=""Target"""
    Windows("macro thing.xls").SmallScroll Down:=-21
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ChartType = xlLine
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).AxisGroup = 2
    ActiveChart.ChartArea.Select
    With ActiveChart
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlCategory, xlSecondary) = True
        .HasAxis(xlValue, xlPrimary) = True
        .HasAxis(xlValue, xlSecondary) = True
    End With
    ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
    ActiveChart.Axes(xlCategory, xlSecondary).CategoryType = xlAutomatic
    ActiveChart.Axes(xlCategory, xlSecondary).Select
    With ActiveChart.Axes(xlCategory, xlSecondary)
        .Crosses = xlMaximum
        .TickLabelSpacing = 1
        .TickMarkSpacing = 1
        .AxisBetweenCategories = False
        .ReversePlotOrder = False
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScale = 1
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    ActiveChart.Axes(xlValue, xlSecondary).Select
    With ActiveChart.Axes(xlValue, xlSecondary)
        .MinimumScaleIsAuto = True
        .MaximumScale = 1
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlMaximum
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlNone
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNone
    End With
    ActiveChart.Axes(xlCategory, xlSecondary).Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlNone
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNone
    End With
End Sub

Changing chart title:

Sub ChangeChartName()
'
' ChangeChartName Macro
' Macro recorded 01/09/2011 by
'
'
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Activate
ActiveChart.ChartArea.Select
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Range("[COLOR=red][B]a44[/B][/COLOR]").Value & " Calls to Conversion Rate"
End With
End Sub

Exporting chart as a picture and renaming the file:

Sub ExportChart()
     '   Export a selected chart as a picture
    Const sSlash$ = "/"
    Const sPicType$ = ".gif"
    Dim sChartName$
    Dim sPath$
    Dim sBook$
    Dim objChart As ChartObject
 
 
    On Error Resume Next
     '   Test if there are even any embedded charts on the activesheet
     '   If not, let the user know
    Set objChart = ActiveSheet.ChartObjects(1)
    If objChart Is Nothing Then
        MsgBox "No charts have been detected on this sheet", 0
        Exit Sub
    End If
 
 
     '   Test if there is a single chart selected
    If ActiveChart Is Nothing Then
        MsgBox "You must select a single chart for exporting ", 0
        Exit Sub
    End If
 
 
Start:
    sChartName = Range("[COLOR=red][B]a44[/B][/COLOR]").Value & " Calls to Conversion Rate"
     '   If a name was given, chart is exported as a picture in the same
     '   folder location as their current file
    sBook = ActiveWorkbook.Path
    sPath = sBook & sSlash & sChartName & sPicType
    ActiveChart.Export Filename:=sPath, FilterName:="GIF"
 
End Sub

Thanks in advance.

 

[aa123]

Bump.

 

[aa123]

With the help of a friend at work I managed to sort it. I'll post the whole code so if someone ever needs to do something similar then they can.

This is what it does:

- Creates a 2-type chart, column and line as the line is used for a target line, based on multiple cell values.
- Renames the chart title based on a single cell value.
- Resizes the chart.
- Exports the chart as a .gif file and renames the file, based on a single cell value.
- Loops through each defined cell, carrying out the prior process for each, until it reaches the end.

Sub ProcessAll()
    Dim current_row As Integer
    Dim first_index As Integer
    Dim last_index As Integer
 
    first_index = 44
    last_index = 77
    For current_row = first_index To last_index
        DoOneChart (current_row)
    Next current_row
 
End Sub
Sub DoOneChart(ByVal idx As Integer)
    Dim Sheet1 As Worksheet
    Set Sheet1 = Worksheets(1)
    Dim sCells As String
    sCells = "D" & CStr(idx) & "," & "G" & CStr(idx) & "," & "J" & CStr(idx) & "," & "M" & CStr(idx) & "," & "P" & CStr(idx)
    Charts.Add
    ActiveChart.ChartType = xlColumnClustered
    ActiveChart.SetSourceData Source:=Sheet1.Range _
        (sCells), PlotBy:=xlRows
        '"D44,G44,J44,M44,P44"), PlotBy:=xlRows
    ActiveChart.SeriesCollection(1).XValues = _
        "=(Sheet1!R42C2,Sheet1!R42C5,Sheet1!R42C8,Sheet1!R42C11,Sheet1!R42C14)"
    ActiveChart.SeriesCollection(1).Name = "=""Conversion Rate"""
    ActiveChart.Location Where:=xlLocationAsObject, Name:="Sheet1"
    With ActiveChart
        .HasTitle = True
        .ChartTitle.Characters.Text = "Conversion Rate"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Conversion %"
    End With
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(2).Values = _
        "=(Sheet1!R116C9,Sheet1!R117C9,Sheet1!R118C9,Sheet1!R119C9,Sheet1!R120C9)"
    ActiveChart.SeriesCollection(2).Name = "=""Target"""
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).ChartType = xlLine
    ActiveChart.SeriesCollection(2).Select
    ActiveChart.SeriesCollection(2).AxisGroup = 2
    ActiveChart.ChartArea.Select
    With ActiveChart
        .HasAxis(xlCategory, xlPrimary) = True
        .HasAxis(xlCategory, xlSecondary) = True
        .HasAxis(xlValue, xlPrimary) = True
        .HasAxis(xlValue, xlSecondary) = True
    End With
    ActiveChart.Axes(xlCategory, xlPrimary).CategoryType = xlAutomatic
    ActiveChart.Axes(xlCategory, xlSecondary).CategoryType = xlAutomatic
    ActiveChart.Axes(xlCategory, xlSecondary).Select
    With ActiveChart.Axes(xlCategory, xlSecondary)
        .Crosses = xlMaximum
        .TickLabelSpacing = 1
        .TickMarkSpacing = 1
        .AxisBetweenCategories = False
        .ReversePlotOrder = False
    End With
    ActiveChart.ChartArea.Select
    ActiveChart.Axes(xlValue).Select
    With ActiveChart.Axes(xlValue)
        .MinimumScaleIsAuto = True
        .MaximumScale = 1
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlAutomatic
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    ActiveChart.Axes(xlValue, xlSecondary).Select
    With ActiveChart.Axes(xlValue, xlSecondary)
        .MinimumScaleIsAuto = True
        .MaximumScale = 1
        .MinorUnitIsAuto = True
        .MajorUnitIsAuto = True
        .Crosses = xlMaximum
        .ReversePlotOrder = False
        .ScaleType = xlLinear
        .DisplayUnit = xlNone
    End With
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlNone
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNone
    End With
    ActiveChart.Axes(xlCategory, xlSecondary).Select
    With Selection.Border
        .Weight = xlHairline
        .LineStyle = xlAutomatic
    End With
    With Selection
        .MajorTickMark = xlNone
        .MinorTickMark = xlNone
        .TickLabelPosition = xlNone
    End With
'
' ChangeChartName Macro
' Macro recorded 01/09/2011 by
'
'
ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count).Activate
ActiveChart.ChartArea.Select
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Sheet1.Cells(idx, 1).Value & " Calls to Conversion Rate"
End With
     '   Resize chart
With ActiveSheet.ChartObjects(ActiveSheet.ChartObjects.Count)
    .Height = 500
    .Width = 500
End With
     '   Export a selected chart as a picture
    Const sSlash$ = "/"
    Const sPicType$ = ".gif"
    Dim sChartName$
    Dim sPath$
    Dim sBook$
    Dim objChart As ChartObject
 
 
    On Error Resume Next
     '   Test if there are even any embedded charts on the activesheet
     '   If not, let the user know
    Set objChart = ActiveSheet.ChartObjects(1)
    If objChart Is Nothing Then
        MsgBox "No charts have been detected on this sheet", 0
        Exit Sub
    End If
 
 
     '   Test if there is a single chart selected
    If ActiveChart Is Nothing Then
        MsgBox "You must select a single chart for exporting ", 0
        Exit Sub
    End If
 
 
Start:
    sChartName = Sheet1.Cells(idx, 1).Value & " Calls to Conversion Rate"
     '   If a name was given, chart is exported as a picture in the same
     '   folder location as their current file
    sBook = ActiveWorkbook.Path
    sPath = sBook & sSlash & sChartName & sPicType
    ActiveChart.Export Filename:=sPath, FilterName:="GIF"
End Sub