asked on

Automating array selection and graph

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...

jppinto

No attachement...

pwflexner

ASKER

OOPS!!
Comparison.xlsx

ASKER CERTIFIED SOLUTION

krishnakrkc

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

pwflexner

ASKER

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?

krishnakrkc

Hi,

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

HTH

Kris

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
    Next
    
    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))
                Next
            End If
        End If
    Next
    If n Then
        With Dest
            .CurrentRegion.ClearContents
            .Value = "Date"
            For c = 1 To UBound(DS)
                .Offset(, c).Value = Hdr(1, DS(c))
            Next
            .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