Create graph with multiple categories

aggarwal18

New Member
Joined
Apr 27, 2015
Messages
3
Hi all

I am trying to create a scatter plot in excel and I am getting my rear kicked for such a simple procedure. My problem is I have a lot of data that needs to be compiled in a scatter plot and doing it manually will not be an option. My data kind of looks like this

Legend Title X Value Y Value
Category 1x1y1
x2y2
x3y3
x4y4
x5y5
Category 2x2,1y2,1
x2,2y2,2
x2,3y2,3
x2,4y2,4
x2,5y2,5
Category 3x3,1y3,1
x3,2y3,2
x3,3y3,3
x3,4y3,4
x3,5y3,5
Category 4x4,1y4,1
x4,2y4,2
x4,3y4,3
x4,4y4,4
x4,5y4,5

<colgroup><col><col span="3"></colgroup><tbody>
</tbody>

This is just an example. I have files with close to 40 categories and have close to 200-300 files. So doing a manual insertion is not an option. I am trying to make a scatter plot which will make a plot with category 1 as the series title and plot x and y and then superimpose the same graph with a different color as category 2 and x and y and so on. Is the a way to automate the process?

Thanks
Abhishek Aggarwal
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
If your data is set up very much like the above example
- Data start in row2
- New Category names in column A
- X, Y data in B:C
- No blank rows between categories

this code will graph the first 256 Categories

Code:
Option Explicit

Sub PlotSeries()

    Dim lLastSeriesNameRow As Long
    Dim lLastSeriesDataRow As Long
    Dim lActiveRow As Long
    Dim lBlockStart As Long
    Dim lBlockEnd As Long
    Dim ser As Series
    Dim sWorksheetName As String
    Dim lSeriesIndex As Long
    
    sWorksheetName = ActiveSheet.Name
    lLastSeriesNameRow = Cells(Rows.Count, 1).End(xlUp).Row
    lLastSeriesDataRow = Cells(Rows.Count, 2).End(xlUp).Row
    ActiveSheet.Shapes.AddChart.Select
    ActiveChart.ChartType = xlXYScatterSmooth
    
    With ActiveChart
        For Each ser In .SeriesCollection
            ser.Delete
        Next
        
        lActiveRow = 2
        Do While lActiveRow <= lLastSeriesNameRow
            lSeriesIndex = lSeriesIndex + 1
            lBlockStart = lActiveRow
            lBlockEnd = Cells(lBlockStart, 1).End(xlDown).Row - 1
            If lBlockEnd > lLastSeriesDataRow Then lBlockEnd = lLastSeriesDataRow
            
            .SeriesCollection.NewSeries
            .SeriesCollection(lSeriesIndex).Name = "=" & sWorksheetName & "!$A$" & lBlockStart
            .SeriesCollection(lSeriesIndex).XValues = "=" & sWorksheetName & "!$B$" & lBlockStart & ":$B$" & lBlockEnd
            .SeriesCollection(lSeriesIndex).Values = "=" & sWorksheetName & "!$C$" & lBlockStart & ":$C$" & lBlockEnd
            lActiveRow = lBlockEnd + 1
        Loop
    End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,552
Messages
6,114,278
Members
448,559
Latest member
MrPJ_Harper

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top