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.

[TABLE="width: 500"]
<TBODY>[TR]
[TD]Customer
[/TD]
[TD]Product
[/TD]
[TD]jan2013
[/TD]
[TD]feb 2013
[/TD]
[TD]march 2013
[/TD]
[TD]april 2013
[/TD]
[/TR]
[TR]
[TD]A
[/TD]
[TD]1
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[/TR]
[TR]
[TD]A
[/TD]
[TD]2
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[/TR]
[TR]
[TD]B
[/TD]
[TD]1
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[/TR]
[TR]
[TD]B
[/TD]
[TD]2
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[/TR]
[TR]
[TD]B
[/TD]
[TD]3
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[TD]x
[/TD]
[/TR]
</TBODY>[/TABLE]

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

 

[C Moore]

try this

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.addChart.Name = customer(ii) & "Chart"
        Sheets("Sheet7").Shapes(customer(ii) & "Chart").Select
        With ActiveChart
            .HasTitle = True
            .ChartType = xlLine
            .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]

Works like a charm!

I'll analyse the macro to understand it.

thank you very much! You spared me hours of work.

SOLVED