Dynamic Ranges, creating multiple graphs, per productgroup / Macro - need experts

[barowan]

Hello there!

I'm new to the VBA-scene and I'm learning this for work. Learned a lot the last few weeks but now my boss is asking me something I can't figure out. (Using MS Office 2010)

I did +300 Charts manually last week(s) and would like (love!) to put it in some macro's. The braindead copying is killing me.

tldr; Help me with next:

I want to put in monthly sales data from customers per product categorie so the charts that I set in a template update automatically. So I have two excel files: the data files where I put in the fresh data and the analysis file which contains charts linked to the data file.

with everything I found on the forum I put together next macro doing a good job. But the problem arrises when there are different products for the same company, as I'd like them on the same charts. All charts have to be done 3 times as in the Data file I have the: Units sheet, Revenue sheet and ASP(Average Selling Price) Sheet.

Customer	Product	jan2013	feb 2013	march 2013	april 2013
A	1	x	x	x	x
A	2	x	x	x	x
B	1	x	x	x	x
B	2	x	x	x	x
B	3	x	x	x	x

<TBODY>
</TBODY>

As above table would represent the Data File for lets say units sold I'd like a chart which shows for customer A the products 1 and 2 sold from jan2013 - april 2013 (if I add may 2013 the chart should update) and for customer B the same but he buys 3 different products so that chart should have 3 series.

As stated above I made a macro who made graphs from data with dynamic ranges. But: it doesn't put series from the same customer together. **** explaining this is hard, show how it's killing me to make the macro.

Underneath the macro; you can test it on any datafile as long as the title of your sheet is "Data"

Hope you can help me.

Sub CreateGraphs()
   'variable declaration
    Dim i As Long
    Dim LastRow As Long
    Dim LastColumn As Long
    Dim chrt As Chart
    Dim UsedRng As Range
    Set UsedRng = ActiveSheet.UsedRange
    Dim Str As String
     
    FirstRow = UsedRng(1).Row
    FirstCol = UsedRng(1).Column
    LastRow = UsedRng(UsedRng.Cells.count).Row
    LastColumn = UsedRng(UsedRng.Cells.count).Column
    'Find the last used row
    
    'Find the last used column

    'Looping from second row till last row which has the data
    For i = 2 To LastRow
        'Sheet 2 is selected bcoz charts will be inserted here
        Sheets("Data").Select
        'Adds chart to the sheet
        Set chrt = Sheets("Data").Shapes.AddChart.Chart
        'sets the chart type
        chrt.ChartType = xlLine
        'now the line chart is added...setting its data source here
        With Sheets("Data")
            chrt.SetSourceData Source:=.Range(.Cells(i, 3), .Cells(i, LastColumn))
        
        'Left & top are used to adjust the position of chart on sheet
            chrt.HasTitle = True
            chrt.ChartArea.Left = 1
            chrt.ChartArea.Top = (i - 2) * chrt.ChartArea.Height
            chrt.PlotBy = xlRows
            chrt.ChartTitle.Text = Cells(i, 1) & " " & Cells(i, 2)
            chrt.SeriesCollection(1).Values = .Range(.Cells(i, 3), .Cells(i, LastColumn))
            chrt.SeriesCollection(1).XValues = .Range(.Cells(1, 3), .Cells(1, LastColumn))
            chrt.SeriesCollection(1).Trendlines.Add Type:=xlLinear
            
            chrt.SetElement (msoElementLegendNone)
            
            
            
            
            
            
            
            
        End With
        Next
End Sub

 

[barowan]

Anyone? Help would be much appreciated!

 

[C Moore]

So the chart from your example table should have two series, one for customer A that is the sum of both products, and a series for customer b of the sum of 3 products?

 

[barowan]

thx for the reply

So the chart from your example table should have two series, one for customer A that is the sum of both products, and a series for customer b of the sum of 3 products?

Sorry If I wasn't that clear.

There should be a chart created for each customer showing each product separetly.

Chart 1: Customer A with series 1 & 2
Chart 2: Customer B with series 1 & 2 & 3
Chart 3: Customer C with series 2 & 3
Chart 4: Customer D with series: (depends on what products have been sold to that customer)
Chart5: and so on

Hope this helps

 

[C Moore]

Instead of 2 to last row you'll need to add a customer(i) beforehand to keep track of how many lines go per chart.

 

[barowan]

Could you be a bit more specific please? As I'm in the learning phase it could be usefull to have a bit more information. But thank you for the respond.

Instead of 2 to last row you'll need to add a customer(i) beforehand to keep track of how many lines go per chart.

 

[barowan]

So how do I change the range of this part

'Looping from second row till last row which has the data
    For i = 2 To LastRow
        'Sheet 2 is selected bcoz charts will be inserted here
        Sheets("Data").Select
        'Adds chart to the sheet
        Set chrt = Sheets("Data").Shapes.AddChart.Chart
        'sets the chart type
        chrt.ChartType = xlLine
        'now the line chart is added...setting its data source here
        With Sheets("Data")
            chrt.SetSourceData Source:=.Range(.Cells(i, 3), .Cells(i, LastColumn))

That it makes 1 chart for each customer with one serie for each product, when the amount of series is variable for each customer / each graph.

Help would be much appreciated.

 

[barowan]

I found this to help, but it doesn't use the dynamic ranges I would like to use use. How can they -easily- be implemented?VBA to Split Data Range into Multiple Chart Series - Peltier Tech Blog

 

[C Moore]

I hope, fingers crossed, you are using an Excel with AddChart2 capability (don't know when it started, mine is 2013). Adjust the following to make yours work.

Sub chart_unique_list()
    Dim customer(1 To 100)
'Spaces in customer name would make this fail, following replaces spaces with underscore
    Range(Range("A1"), Range("A1").End(xlDown)).Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Create customer name variables
    Range(Range("A1"), Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'Turn On Filter, filter in place for unique values
    Range(Range("A2"), Range("A2").End(xlDown)).SpecialCells(xlCellTypeVisible).Select 'Select unique values
    num_customers = Selection.Cells.Count 'Count unique values
    i = 0
    For Each cellx In Selection.SpecialCells(xlCellTypeVisible)
        i = i + 1
        customer(i) = cellx.Value
    Next cellx
    ActiveSheet.ShowAllData 'Remove Filter
'Create charts
    For ii = 1 To num_customers
        Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=customer(ii)
        Range(Range("B1"), Range("B2").End(xlToRight).End(xlDown)).SpecialCells(xlCellTypeVisible).Select
        Sheets("Sheet7").Shapes.AddChart2(227, xlLineMarkers).Name = customer(ii) & "Chart"
        Sheets("Sheet7").Shapes(customer(ii) & "Chart").Select
        With ActiveChart
            .HasTitle = True
            .ChartTitle.Caption = customer(ii)
        End With
    Next ii
'Remove filter
    Sheets("Sheet7").Range("A1").Select
    ActiveSheet.AutoFilterMode = False
'Arrange charts
    For a = 1 To num_customers
        Sheets("Sheet7").Shapes(customer(a) & "Chart").Select
        With ActiveChart
            .ChartArea.Left = 350
            .ChartArea.Top = (a - 1) * ActiveChart.ChartArea.Height
        End With
    Next a
    Sheets("Sheet7").Range("A1").Select
End Sub

 

[barowan]

I hope, fingers crossed, you are using an Excel with AddChart2 capability (don't know when it started, mine is 2013). Adjust the following to make yours work.

Sub chart_unique_list()
    Dim customer(1 To 100)
'Spaces in customer name would make this fail, following replaces spaces with underscore
    Range(Range("A1"), Range("A1").End(xlDown)).Replace What:=" ", Replacement:="_", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
'Create customer name variables
    Range(Range("A1"), Range("A1").End(xlDown)).AdvancedFilter Action:=xlFilterInPlace, Unique:=True 'Turn On Filter, filter in place for unique values
    Range(Range("A2"), Range("A2").End(xlDown)).SpecialCells(xlCellTypeVisible).Select 'Select unique values
    num_customers = Selection.Cells.Count 'Count unique values
    i = 0
    For Each cellx In Selection.SpecialCells(xlCellTypeVisible)
        i = i + 1
        customer(i) = cellx.Value
    Next cellx
    ActiveSheet.ShowAllData 'Remove Filter
'Create charts
    For ii = 1 To num_customers
        Range("A1").CurrentRegion.AutoFilter Field:=1, Criteria1:=customer(ii)
        Range(Range("B1"), Range("B2").End(xlToRight).End(xlDown)).SpecialCells(xlCellTypeVisible).Select
        Sheets("Sheet7").Shapes.AddChart2(227, xlLineMarkers).Name = customer(ii) & "Chart"
        Sheets("Sheet7").Shapes(customer(ii) & "Chart").Select
        With ActiveChart
            .HasTitle = True
            .ChartTitle.Caption = customer(ii)
        End With
    Next ii
'Remove filter
    Sheets("Sheet7").Range("A1").Select
    ActiveSheet.AutoFilterMode = False
'Arrange charts
    For a = 1 To num_customers
        Sheets("Sheet7").Shapes(customer(a) & "Chart").Select
        With ActiveChart
            .ChartArea.Left = 350
            .ChartArea.Top = (a - 1) * ActiveChart.ChartArea.Height
        End With
    Next a
    Sheets("Sheet7").Range("A1").Select
End Sub

Hi C Moore

Thank you very much for your reply.

As stated in the OP I'm using the 2010 MS Office :/
I'm trying to learn / understand the code you sent me.
I'm sorry I can't use it I think.

Is there any other way possible to do this, as I can't use your solution.

EDIT:

I just see if I change the Addchart2 to Addchart and swap the Rows & Colums I get 1 chart giving me what I need / want!! Thank you very much for that. After that the macro still gives me an error, but still, every inch forward is one closer to the finish!