?
Solved

Dynamic Ranges for Charts

Posted on 2014-03-10
7
Medium Priority
?
142 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 2
7 Comments
 
LVL 31

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 31

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
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

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.

 
LVL 31

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 31

Accepted Solution

by:
gowflow earned 2000 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 31

Expert Comment

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

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
: Microsoft Office Collaborate for free and online versions of Microsoft  Word, Excel, Powerpoint, OneNote, Onedrive , Email, Calendar etc. In short we can say that Microsoft office is a suite of servers, applications and services developed by  Micr…
Viewers will learn the basics about Excel 2013’s new Flash Fill feature.
Viewers will learn how to share Excel data with others from desktop Excel, as well as Excel Online via OneDrive, and embed an Excel file on a website.

752 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