• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 242
  • Last Modified:

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...
0
pwflexner
Asked:
pwflexner
  • 2
  • 2
1 Solution
 
jppintoCommented:
No attachement...
0
 
pwflexnerAuthor Commented:
0
 
krishnakrkcCommented:
Hi,

Here  you go.

Kris
Comparison.xlsm
0
 
pwflexnerAuthor Commented:
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?
0
 
krishnakrkcCommented:
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

0

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

  • 2
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now