Automating array selection and graph

Posted on 2011-05-06
Last Modified: 2012-06-27
I want to create a spreadsheet that automatically build an array of data (based on user selections) taken from a larger array of data, and then create a graph of the selected array data.  I have attached a spreadsheet as an example.  On the Dataset tab are a series of datasets with monthly data.  On the Select tab in cells D4 through D8 are the datasets selected for inclusion .  Cells G4 and G6 show the start and end months selected.  After a macro "Run" button is pushed, the data below the selection criteria should be automatically created.  That's step 1.  Step 2 would be to have a graph of the data automatically be generated.

I hope this is doable for the points...
Question by:pwflexner
    LVL 33

    Expert Comment

    No attachement...

    Author Comment

    LVL 18

    Accepted Solution


    Here  you go.


    Author Closing Comment

    Perfect!!  I would like to modify the macro slightly to allow for handling the addition of more datasets as well as additional months of data over time.  I'll allocate another 250 points for this, but I'm not sure how to do so.  Can you help me with this?
    LVL 18

    Expert Comment


    I have commented the lines where you need to adjust the ranges for the additional datasets.


    Sub kTest()
        Dim DataSets, lRow As Long, Dest   As Range, Hdr, x
        Dim wksSelect   As Worksheet, wksDsets  As Worksheet
        Dim sDt         As Long, eDt As Long, c As Long
        Dim dSets, i As Long, n As Long, DS(), arrOutput()
        Dim chtObj      As ChartObject
        Dim chtChart    As Chart
        Set wksSelect = Worksheets("Select")
        Set wksDsets = Worksheets("Datasets")
        With wksDsets
            lRow = .Range("b" & .Rows.Count).End(xlUp).Row
            DataSets = .Range("b4:k" & lRow) '<< replace 'k' with the last dataset column
            Hdr = .Range("b4:k4") '<< replace 'k' here as well
        End With
        With wksSelect
            sDt = .Range("g4")
            eDt = .Range("g6")
            dSets = .Range("d4:d8") '<< adjust the range for additional dataset selection
            Set Dest = .Range("c13") '<< where you paste the output
        End With
        For i = 1 To UBound(dSets, 1)
            If (dSets(i, 1) <> "Empty") * Len(dSets(i, 1)) Then
                n = n + 1
                ReDim Preserve DS(1 To n)
                x = Application.Match(dSets(i, 1), Hdr, 0)
                DS(n) = x
            End If
        ReDim arrOutput(1 To 100, 1 To n + 1)
        n = 0
        For i = 1 To UBound(DataSets, 1)
            If IsDate(DataSets(i, 1)) Then
                If ((CLng(DataSets(i, 1)) >= sDt) * (CLng(DataSets(i, 1)) <= eDt)) Then
                    n = n + 1
                    arrOutput(n, 1) = DataSets(i, 1)
                    For c = 1 To UBound(DS)
                        arrOutput(n, c + 1) = DataSets(i, DS(c))
                End If
            End If
        If n Then
            With Dest
                .Value = "Date"
                For c = 1 To UBound(DS)
                    .Offset(, c).Value = Hdr(1, DS(c))
                .Offset(1).Resize(n, UBound(arrOutput, 2)).Value = arrOutput
                .Offset(1).Resize(n).NumberFormat = "mmm-yy"
                On Error Resume Next
                Set chtObj = .Parent.ChartObjects(1)
                On Error GoTo 0
                If chtObj Is Nothing Then
                    With .Offset(, UBound(DS) + 2)
                        Set chtObj = .Parent.ChartObjects.Add(.Left, .Top, 500, 400)
                    End With
                End If
                Set chtChart = chtObj.Chart
                With chtChart
                    .SetSourceData Dest.Resize(n, UBound(arrOutput, 2)), 2
                    .ChartType = xlLine
                End With
            End With
        End If
    End Sub

    Open in new window


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    What Security Threats Are You Missing?

    Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

    Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
    Introduction This Article is a follow-up to my Mappit! Addin Article (, it was inspired by an email posting I made to EUSPRIG (, I will briefly cover: 1) An overvie…
    The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
    This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

    758 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    13 Experts available now in Live!

    Get 1:1 Help Now