Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Macro for graph 1

Status
Not open for further replies.

rajltd

IS-IT--Management
Sep 25, 2003
38
0
0
GB
Hi,

Can I be able to select a larger graph range instead of B2:F4. The thing is, this graph can vary in columns and rows. Moreover i have to ignore c-column, thats why I have taken as activesheet.seriescollection(1).delete. One more thing - "ABC" is in the first column - not R1C1. Can i select it in any way instead of hard-coding it (i mean selecting a cell). And same with "Date" and "Position".

Charts.Add
ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="Logarithmic"
ActiveChart.SetSourceData Source:=Sheets("Keyword_Analysis").Range("B2:F4"), _
PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Name = "=Keyword_Analysis!R1C4"
ActiveChart.SeriesCollection(2).Name = "=Keyword_Analysis!R1C5"
ActiveChart.SeriesCollection(3).Name = "=Keyword_Analysis!R1C6"
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart1"

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "ABC"
.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Position"


Any help will be appreciated. Thanks in advance.

Raj
 
Hi Raj,

You can make your column ranges (additional rows in existing columns) dynamic by using the OFFSET function. However, adding new columns (new series) cannot be done via worksheet functions.

Here are the rules for your case.

Column headings in Row 1
column data in row 2 and following -- no empty cells
Each column defined with a range name in Insert/Name/Define with offset formula -- for instance in column A
Code:
=OFFSET(Sheet1!$A$2,0,0,COUNTA(Sheet1!$A:$A)-1,1)
I named this range rCattegory since it is my category axis data.

In the chart, source data series tab, replace the range reference after the ! with the range name.

Do the same for each series.

Now your chart is dynamic for existing series.

To accomplish adding new series will take a VBA procedure -- alot more complex.

:)

Skip,
 
I dont think I have explained u properly. So i am sending u table as well as the macro.

For the following table, I have written the macro to obtain the graph. But the problem is the no. of column and rows can change as new data comes in... So I dont want to hard code particularly the first part of macro... Please help.


Keyword Date Total Of Value XYZ TUV RST
ABC 27/10/2003 7 7 11 100
ABC 27/11/2003 7 3 5 15
ABC 27/12/2003 7 10 200 25


Sub Graph()

Charts.Add

ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:="Logarithmic"
ActiveChart.SetSourceData Source:=Sheets("Keyword_Analysis").Range("B2:F4"), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Name = "=Keyword_Analysis!R1C4"
ActiveChart.SeriesCollection(2).Name = "=Keyword_Analysis!R1C5"
ActiveChart.SeriesCollection(3).Name = "=Keyword_Analysis!R1C6"

ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="Chart1"

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "ABC"
.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Date"
.Axes(xlValue, xlPrimary).HasTitle = True




.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Position"

End With

ActiveChart.PlotArea.Select
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False

ActiveChart.Legend.Select

With Selection.Interior
.ColorIndex = 34
End With

ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 20
End With

ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
End With

ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True

With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 12
End With

ActiveChart.Axes(xlCategory).AxisTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 14
End With

ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True

With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Regular"
.Size = 12
End With

With Selection.TickLabels
.Alignment = xlCenter
.Offset = 100
.Orientation = 45
End With

ActiveChart.Legend.Select

Selection.Shadow = True

With Selection.Interior
.ColorIndex = 34
End With

ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
End With

With Selection.Interior
.ColorIndex = 34
.PatternColorIndex = 1
.Pattern = xlSolid
End With

ActiveChart.ChartArea.Select
Selection.Shadow = True


End Sub


Thanks

Raj
 
Raj,

Here's a macro to run on your ALREADY CREATED CHART whenever you add rows or columns.

It assumes that...
the series data starts in column 4
the columns headings have NO SPACES
Code:
Sub ResizeRanges()
    Application.DisplayAlerts = False
    Cells(1, 1).CurrentRegion.CreateNames _
        Top:=True, Left:=False, Bottom:=False, Right:=False
    Application.DisplayAlerts = True
End Sub
Sub ResizeChart()
    ResizeRanges
    With Charts(1)
        .SeriesCollection(1).XValues = "=Sheet4!" & Sheets("Sheet4").Cells(1, 1).Value
        For i = 4 To Sheets("Sheet4").Cells(1, 4).End(xlToRight).Column
            If i - 3 <= .SeriesCollection.Count Then
                .SeriesCollection(i - 3).Name = Sheets(&quot;Sheet4&quot;).Cells(1, i).Value
                .SeriesCollection(i - 3).Values = &quot;=Sheet4!&quot; & Sheets(&quot;Sheet4&quot;).Cells(1, i).Value
            Else
                .SeriesCollection.Add Source:=Worksheets(&quot;sheet4&quot;).Range(Sheets(&quot;Sheet4&quot;).Cells(1, i).Value)
                .SeriesCollection(i - 3).Name = Sheets(&quot;Sheet4&quot;).Cells(1, i).Value
            End If
        Next
    End With
End Sub
:)

Skip,
 
Its confusing to add these macros as it doesnt work when i run it. I wanted to make it simple so that macros can identify the no. of rows and columns and take that data and represent it into the graph. Sometimes the data might have n row and m columns while sometimes different nos. of rows and columns which vary all the time.

Raj
 
I have worked it out the whole thing.... Now I have to just make sure that this macro is not specific to any particular worksheet. I mean want this macro to work on any worksheet rather than just Keyword_Analysis. If you can help me on this thing, then it would be great help.

Thanks

Sub Graph()

Dim EndCell As Range
Dim iRow As Integer, iCol As Integer, iSeries As Integer

iRow = Cells(Rows.Count, 1).End(xlUp).Row
iCol = Cells(1, Columns.Count).End(xlToLeft).Column
Set EndCell = Cells(iRow, iCol)


Charts.Add

ActiveChart.ApplyCustomType ChartType:=xlBuiltIn, TypeName:=&quot;Logarithmic&quot;
ActiveChart.SetSourceData Source:=Sheets(&quot;Keyword_Analysis&quot;).Range(&quot;B2&quot;, EndCell), PlotBy:=xlColumns
ActiveChart.SeriesCollection(1).Delete

For iSeries = 1 To iCol - 3

ActiveChart.SeriesCollection(iSeries).Name = &quot;=Keyword_Analysis!R1C&quot; & iSeries + 3

Next iSeries


ActiveChart.Location Where:=xlLocationAsNewSheet, Name:=&quot;Chart1&quot;

With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = Sheets(&quot;Keyword_Analysis&quot;).Cells(2, 1).Value
.Axes(xlCategory, xlPrimary).HasTitle = True

.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = &quot;Date&quot;
.Axes(xlValue, xlPrimary).HasTitle = True

.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = &quot;SE List Position&quot;

End With

ActiveChart.PlotArea.Select
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False

ActiveChart.Legend.Select

With Selection.Interior
.ColorIndex = 34
End With

ActiveChart.ChartTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Bold&quot;
.Size = 20
End With

ActiveChart.Axes(xlValue).AxisTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Bold&quot;
.Size = 14
End With

ActiveChart.Axes(xlValue).Select
Selection.TickLabels.AutoScaleFont = True

With Selection.TickLabels.Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Regular&quot;
.Size = 12
End With

ActiveChart.Axes(xlCategory).AxisTitle.Select
Selection.AutoScaleFont = True

With Selection.Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Bold&quot;
.Size = 14
End With

ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.AutoScaleFont = True

With Selection.TickLabels.Font
.Name = &quot;Arial&quot;
.FontStyle = &quot;Regular&quot;
.Size = 12
End With

With Selection.TickLabels
.Alignment = xlCenter
.Offset = 100
.Orientation = 45
End With

ActiveChart.Legend.Select

Selection.Shadow = True

With Selection.Interior
.ColorIndex = 34
End With

ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 16
End With

With Selection.Interior
.ColorIndex = 34
.PatternColorIndex = 1
.Pattern = xlSolid
End With

ActiveChart.ChartArea.Select
Selection.Shadow = True
End Sub


Thanks again.

Raj
 
I just regrouped things using the With...End With structure. Can't see anything wrong with your code
Code:
Sub Graph()

    Dim EndCell As Range
    Dim iRow As Integer, iCol As Integer, iSeries As Integer
    
    iRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    iCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Set EndCell = Cells(iRow, iCol)

    Charts.Add
    
    With ActiveChart
        .ApplyCustomType ChartType:=xlBuiltIn, TypeName:=&quot;Logarithmic&quot;
        .SetSourceData _
            Source:=Sheets(&quot;Keyword_Analysis&quot;).Range(&quot;B2&quot;, EndCell), _
            PlotBy:=xlColumns
        .SeriesCollection(1).Delete
    
        For iSeries = 1 To iCol - 3
            
            .SeriesCollection(iSeries).Name = &quot;=Keyword_Analysis!R1C&quot; & iSeries + 3
        
        Next iSeries
    
        .Location Where:=xlLocationAsNewSheet, Name:=&quot;Chart1&quot;
    End With
    
    With ActiveChart
        .HasTitle = True
        With .ChartTitle
            .Characters.Text = Sheets(&quot;Keyword_Analysis&quot;).Cells(2, 1).Value
            .AutoScaleFont = True
            With .Font
                .Name = &quot;Arial&quot;
                .FontStyle = &quot;Bold&quot;
                .Size = 20
            End With
        End With
    
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = True
            With .AxisTitle
                .Characters.Text = &quot;Date&quot;
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Bold&quot;
                    .Size = 14
                End With
            End With
            With .TickLabels
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Regular&quot;
                    .Size = 12
                End With
                .Alignment = xlCenter
                .Offset = 100
                .Orientation = 45
            End With
        End With
        With .Axes(xlValue, xlPrimary)
            .HasTitle = True
            With .AxisTitle
                .Characters.Text = &quot;SE List Position&quot;
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Bold&quot;
                    .Size = 14
                End With
            End With
            With .TickLabels
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Regular&quot;
                    .Size = 12
                End With
            End With
        End With
        
        .ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
        
        With .Legend
            .Interior.ColorIndex = 34
            .Shadow = True
        End With
        
        With .PlotArea
            .Border.ColorIndex = 16
            With .Interior
                .ColorIndex = 34
                .PatternColorIndex = 1
                .Pattern = xlSolid
            End With
        End With
        
        .ChartArea.Shadow = True
    
    End With
End Sub


Skip,
 
In these three lines the use of word &quot;Keyword_Analysis&quot; restricts the macro to run only on the worksheet with the name &quot;Keyword_Analysis&quot;. I want the above macro to run on any worksheet with the similar formating. I hope i have made my point clear... I am not very good at expaining things. sorry about that.


Source:=Sheets(&quot;Keyword_Analysis&quot;).Range(&quot;B2&quot;, EndCell), _
PlotBy:=xlColumns

.SeriesCollection(iSeries).Name = &quot;=Keyword_Analysis!R1C&quot; & iSeries + 3

With ActiveChart
.HasTitle = True
With .ChartTitle
.Characters.Text = Sheets(&quot;Keyword_Analysis&quot;).Cells(2, 1).Value


Anyways thanks for replying and would appreciate your help in above matter.

Raj
 
Sorry,

I added a sheet object, wsSource.
Run this from the source data sheet.
Code:
Sub Graph()

    Dim EndCell As Range, wsSource As Worksheet
    Dim iRow As Integer, iCol As Integer, iSeries As Integer
    
    Application.DisplayAlerts = False
    
    Set wsSource = ActiveSheet
    
    iRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
    iCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
    Set EndCell = Cells(iRow, iCol)

    Charts.Add
    
    With ActiveChart
        .ApplyCustomType ChartType:=xlBuiltIn, TypeName:=&quot;Logarithmic&quot;
        .SetSourceData _
            Source:=wsSource.Range(&quot;B2&quot;, EndCell), _
            PlotBy:=xlColumns
        .SeriesCollection(1).Delete
    
        For iSeries = 1 To iCol - 3
            
            .SeriesCollection(iSeries).Name = &quot;=&quot; & wsSource.Name & &quot;!R1C&quot; & iSeries + 3
        
        Next iSeries
    
        .Location Where:=xlLocationAsNewSheet, Name:=&quot;Chart1&quot;
    End With
    
    With ActiveChart
        .HasTitle = True
        With .ChartTitle
            .Characters.Text = wsSource.Cells(2, 1).Value
            .AutoScaleFont = True
            With .Font
                .Name = &quot;Arial&quot;
                .FontStyle = &quot;Bold&quot;
                .Size = 20
            End With
        End With
    
        With .Axes(xlCategory, xlPrimary)
            .HasTitle = True
            With .AxisTitle
                .Characters.Text = &quot;Date&quot;
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Bold&quot;
                    .Size = 14
                End With
            End With
            With .TickLabels
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Regular&quot;
                    .Size = 12
                End With
                .Alignment = xlCenter
                .Offset = 100
                .Orientation = 45
            End With
        End With
        With .Axes(xlValue, xlPrimary)
            .HasTitle = True
            With .AxisTitle
                .Characters.Text = &quot;SE List Position&quot;
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Bold&quot;
                    .Size = 14
                End With
            End With
            With .TickLabels
                .AutoScaleFont = True
                With .Font
                    .Name = &quot;Arial&quot;
                    .FontStyle = &quot;Regular&quot;
                    .Size = 12
                End With
            End With
        End With
        
        .ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
        
        With .Legend
            .Interior.ColorIndex = 34
            .Shadow = True
        End With
        
        With .PlotArea
            .Border.ColorIndex = 16
            With .Interior
                .ColorIndex = 34
                .PatternColorIndex = 1
                .Pattern = xlSolid
            End With
        End With
        
        .ChartArea.Shadow = True
    
    End With
    Application.DisplayAlerts = True
End Sub

Skip,
 
In hindsight, I would change one other statement...
Code:
.Location Where:=xlLocationAsNewSheet, Name:=&quot;Chart&quot; & Charts.Count
This will allow you to add more that one chart to a workbook, if you have multiple source sheets.

:)

Skip,
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top