Solved

Dynamic Ranges for Charts

Posted on 2014-03-10
7
133 Views
Last Modified: 2014-03-13
Good Afternoon,

I am trying to set up dynamic ranges for my charts.  I have attached an example of the spreadsheet.  The chart should only show the information for the department and month selected.  For example, March only has 9 days updated, so the chart should only show the first 9 days.

Thanks in advanced,
Joan
DailyRev2014.xlsx
0
Comment
Question by:jmkbrown
  • 5
  • 2
7 Comments
 
LVL 29

Expert Comment

by:gowflow
ID: 39919922
Is this what you want ?? This sub will adjust the Graph's serie to match the last row of data in sheet Daily Col L to S

I created a button on the Dashboard that you can activate it will adjust the data to match for that graph.

Sub AdjustChartDataRange()
Dim oChrt As ChartObject
Dim Chrt As Chart
Dim sSerie As Series
Dim WS As Worksheet
Dim WSDaily As Worksheet
Dim MaxRow As Long, I As Long
Dim Frmla As String, fmRow As String, toRow As String
Dim SplitFrmla

Set WS = ActiveSheet
Set WSDaily = Sheets("Daily")

Do
    MaxRow = MaxRow + 1
Loop Until WSDaily.Cells(MaxRow, "L") = ""
If MaxRow > 1 Then MaxRow = MaxRow - 1

For Each oChrt In WS.ChartObjects
    If oChrt.Name = "Chart 1" Then
        Set Chrt = oChrt.Chart
        
        For Each sSerie In Chrt.SeriesCollection
            Frmla = sSerie.Formula
            SplitFrmla = Split(Frmla, ",")
            For I = LBound(SplitFrmla) To UBound(SplitFrmla)
                If InStr(1, SplitFrmla(I), ":") <> 0 Then
                    '---> Get the ToRow
                    toRow = Mid(SplitFrmla(I), InStrRev(SplitFrmla(I), "$") + 1, Len(SplitFrmla(I)) - InStrRev(SplitFrmla(I), "$"))
                    SplitFrmla(I) = Replace(SplitFrmla(I), toRow, Format(MaxRow, "@"))
                End If
            
            Next I
            
            Frmla = ""
            For I = LBound(SplitFrmla) To UBound(SplitFrmla)
                If Frmla <> "" Then Frmla = Frmla & ","
                Frmla = Frmla & SplitFrmla(I)
            Next I
            
            '---> Affect  New Formula
            sSerie.Formula = Frmla
        Next sSerie
    
    End If
Next oChrt
End Sub

Open in new window


Let me know
gowflow
DailyRev2014.xlsm
0
 

Author Comment

by:jmkbrown
ID: 39921918
I would like for this to work any time the user changes the value in cell E1 and I only want it to change "Chart 1".  The other charts I will be adding to the spreadsheet will be based on other data, therefore I only want chart 1 to change.

Thanks!
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39922061
ok I must hv messed up your data for the second chart, Sorry !!!
Here it is now will only do that for Chart1 (although the previous version was only doing it for Chart1) don't really know why data disappeared for Chart2. and it will work when you select a department. I removed the button.

gowflow
DailyRev2014-V01.xlsm
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 29

Expert Comment

by:gowflow
ID: 39922073
OOOPSSSS !!!!

You said E1 !!!

I had never realized there was an E1 at the first place that list the months and that could be changed !!!

Pls do not consider the previous version let me revise the whole thing will get back to you.

Sorry again but your dropdown are too much 'cramped' with the heading and can be hardly seen !!! (at least for someone who did not design them)

Will revert
gowflow
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 39922844
Well I have to admit it was not an easy one !!! as your data when filtered (when you flip between month or departments ..) it does leave blanks rows that are blank between header and real data which was causing all this mess.

I was able to fix all this and here is the code that get triggered either if you change a department or when you change a month. For sure when you select a month that has no data like Apr and up then the graph is blank which is normal.

I do not know what was the ranges affected to the second graph I made sure the below code will only affect the first Chart1.

Please check the attached file and let me know your comments.

here is the code for your convenience.

Sub AdjustChartDataRange()
Dim oChrt As ChartObject
Dim Chrt As Chart
Dim sSerie As series
Dim WS As Worksheet
Dim WSDaily As Worksheet
Dim MaxRow As Long, MinRow As Long, I As Long
Dim Frmla As String, fmRow As String, toRow As String
Dim SplitFrmla
Dim DataRange As Range

Set WS = ActiveSheet
Set WSDaily = Sheets("Daily")
'MsgBox ("X")
MinRow = 0
MaxRow = 0

For I = 2 To WSDaily.Range("L" & WSDaily.Rows.Count).End(xlUp).Row
    If WSDaily.Cells(I, "L").Value <> "" And MinRow = 0 Then
        MinRow = I
        MaxRow = I
    End If
    
    If WSDaily.Cells(I, "L").Value <> "" And I > MaxRow Then
        MaxRow = I
    End If
    
Next I

If MinRow = 0 Or MaxRow = 0 Then Exit Sub

For Each oChrt In WS.ChartObjects
    If oChrt.Name = "Chart 1" Then
        Set Chrt = oChrt.Chart
        
        For Each sSerie In Chrt.SeriesCollection
            
            Frmla = sSerie.Formula
            SplitFrmla = Split(Frmla, ",")
            For I = LBound(SplitFrmla) To UBound(SplitFrmla)
                
                If I = LBound(SplitFrmla) Then
                    '---> On first Item Make sure Row is always 1
                    '---> Get the fmRow
                    fmRow = Mid(SplitFrmla(I), InStrRev(SplitFrmla(I), "$") + 1, Len(SplitFrmla(I)) - InStrRev(SplitFrmla(I), "$"))
                    SplitFrmla(I) = Replace(SplitFrmla(I), fmRow, Format(1, "@"), , 1)

                    
                ElseIf InStr(1, SplitFrmla(I), ":") = 0 And InStr(1, SplitFrmla(I), "$") <> 0 Then
                    '---> If $ exist but not : then Change fmRow
                    '---> Get the fmRow
                    fmRow = Mid(SplitFrmla(I), InStrRev(SplitFrmla(I), "$") + 1, Len(SplitFrmla(I)) - InStrRev(SplitFrmla(I), "$"))
                    SplitFrmla(I) = Replace(SplitFrmla(I), fmRow, Format(MinRow, "@"), , 1)
                
                ElseIf InStr(1, SplitFrmla(I), ":") <> 0 And InStr(1, SplitFrmla(I), "$") <> 0 Then
                    '---> If $ exist and : exist change both fmRow and toRow
                    '---> Get the ToRow
                    toRow = Mid(SplitFrmla(I), InStrRev(SplitFrmla(I), "$") + 1, Len(SplitFrmla(I)) - InStrRev(SplitFrmla(I), "$"))
                    SplitFrmla(I) = Replace(SplitFrmla(I), toRow, Format(MaxRow, "@"), , 1)
                    
                    '---> Get the fmRow
                    fmRow = Mid(SplitFrmla(I), InStrRev(SplitFrmla(I), "$", InStrRev(SplitFrmla(I), ":")) + 1, InStrRev(SplitFrmla(I), ":") - InStrRev(SplitFrmla(I), "$", InStrRev(SplitFrmla(I), ":")) - 1)
                    SplitFrmla(I) = Replace(SplitFrmla(I), fmRow, Format(MinRow, "@"), , 1)
                
                ElseIf I = 1 And SplitFrmla(I) = "" Then
                    '---> Force Creation of the Formula
                    SplitFrmla(I) = "Daily!$M$" & Format(MinRow, "@") & ":$M$" & Format(MaxRow, "@")
                
                End If
            
            Next I
            
            Frmla = ""
            For I = LBound(SplitFrmla) To UBound(SplitFrmla)
                If Frmla <> "" Then Frmla = Frmla & ","
                Frmla = Frmla & SplitFrmla(I)
            Next I
            
            '---> Affect  New Formula
            sSerie.Formula = Frmla
        Next sSerie
        
        Exit For
    End If
    
Next oChrt
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B1")) Is Nothing Or Not Intersect(Target, Range("E1")) Is Nothing Then
    AdjustChartDataRange
End If
End Sub

Open in new window


PS I highlighted both Department and Month to make it clear ! if you don't like it no problem it can be removed safely.
Gowflow
DailyRev2014-V02.xlsm
0
 

Author Closing Comment

by:jmkbrown
ID: 39926235
This works great!  Thank you very much!
0
 
LVL 29

Expert Comment

by:gowflow
ID: 39926737
Your welcome glad I could help.
gowflow
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

What is Backup? Backup software creates one or more copies of the data on your digital devices in case your original data is lost or damaged. Different backup solutions protect different kinds of data and different combinations of devices. For e…
Is your company's data protection keeping pace with virtualization? Here are 7 dynamic ways to adapt to rapid breakthroughs in technology.
Viewers will learn how to apply various conditional formatting in Excel 2013.
Viewers will learn the basics of using filtering and sorting in Excel 2013.

760 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

19 Experts available now in Live!

Get 1:1 Help Now