Advertisement

09.07.2008 at 10:52AM PDT, ID: 23710396
[x]
Attachment Details

Updating Excel Chart range via vba/macros

[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.3
Zones:

Automation, Microsoft Excel Spreadsheet Software

Tags:

Microsoft, excel, 2003
Hi there,

I am currently running a code which automatically updates 30 or sharts at once by adding 1 column to the beginning and end of the series. For example Chart 1 refers to columns A to E, after running the macro the Range will change to B to F.
Currently, all the charts have 3 series, if i try to add a 4th series to the chart and macro it does not work.

How can I amend the code so that it updates all 4 series in all of the charts instead of updating just three series for all charts?

I have added the 4th series to each of the chart, that I would like to be updated along with the 3 other series that are being update everytime i run the macro.

Your help would be kindly appreciated.
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:

Option Explicit
 
Sub WeeklyChartUpdate()
Call UpdateChartFormula
Call SetPrintArea
MsgBox "Chart areas updated", vbOKOnly
End Sub
 
 
Sub UpdateChartFormula()
Dim chrt As Object
Dim i As Integer, k As Integer
Dim SeriesFormula() As String, ReturnFormula As String, R1C1Part As String
Const CurrentYear As String = "2008"
 
For Each chrt In ActiveSheet.ChartObjects
    Select Case True
        'checks chart names that have been defined using one off sub NameCharts()
        'will categorise charts as either "rolling" type or "yearly" type - they need
        'to be treated differently
        Case chrt.Name Like "*Rolling*"
            'change start and end points of all series
            For i = 1 To chrt.Chart.SeriesCollection.Count
                SeriesFormula = Split(chrt.Chart.SeriesCollection(i).FormulaR1C1, ",")
                For k = 0 To UBound(SeriesFormula)
                    Debug.Print SeriesFormula(k)
                    If k = 1 Or k = 2 Then
                        'AXIS or VALUE part of formula (these are fixed positions 1 & 2)
                        'we want to change both parts of the formula - the start and the end point
                        'the "rolling" charts are a 12 week rolling total summary so both points move
                        'find the first RC part of the formula (from the ! to the : part)
                        'add 1 to the C
                        R1C1Part = Mid(SeriesFormula(k), InStr(1, SeriesFormula(k), "!") + 1, (Len(SeriesFormula(k)) - InStr(1, SeriesFormula(k), ":")) - 1)
                        SeriesFormula(k) = Replace(SeriesFormula(k), R1C1Part, OffsetC1(R1C1Part))
                        'find the second RC part of the formula (from the : to the end)
                        'add 1 to the C
                        R1C1Part = Mid(SeriesFormula(k), InStr(1, SeriesFormula(k), ":") + 1)
                        SeriesFormula(k) = Replace(SeriesFormula(k), R1C1Part, OffsetC1(R1C1Part))
                    End If
                Next k
            'rebuild formula
            ReturnFormula = Join(SeriesFormula(), ",")
            chrt.Chart.SeriesCollection(i).FormulaR1C1 = ReturnFormula
            Next i
        Case chrt.Name Like "*Yearly*"
            'change current year series only - this will need to be changed on a yearly basis!!!
            For i = 1 To chrt.Chart.SeriesCollection.Count
                If chrt.Chart.SeriesCollection(i).Name Like "*" & CurrentYear & "*" Then
                    SeriesFormula = Split(chrt.Chart.SeriesCollection(i).FormulaR1C1, ",")
                    For k = 0 To UBound(SeriesFormula)
                        Debug.Print SeriesFormula(k)
                        If k = 2 Then
                            'VALUE part of formula only
                            'find ONLY the second RC part of the formula (from the : to the end)
                            'we don't want to change the starting point for the current year series, or the AXIS values-
                            'always want to see the year to date totals
                            R1C1Part = Mid(SeriesFormula(k), InStr(1, SeriesFormula(k), ":") + 1)
                            SeriesFormula(k) = Replace(SeriesFormula(k), R1C1Part, OffsetC1(R1C1Part))
                        End If
                    Next k
                    'rebuild formula
                    ReturnFormula = Join(SeriesFormula(), ",")
                    chrt.Chart.SeriesCollection(i).FormulaR1C1 = ReturnFormula
                
                End If
            Next i
        Case Else
            MsgBox "Unrecognised Chart name - if you have inserted a new chart you will need to rename it. Please contact IT (hs)", vbCritical, "SOME CHARTS WILL NOT UPDATE PROPERLY"
    End Select
 
Next chrt
End Sub
 
Sub SetPrintArea()
    Dim PA1 As String, PA2 As String, PA As String
    'Print areas
    Dim D1Pos As Integer, D2Pos As Integer, D3Pos As Integer, D4Pos As Integer
    'Position of $ in string - to calculate where the column headers are
    'takes current print area and moves it along 1
    D1Pos = InStr(1, ActiveSheet.PageSetup.PrintArea, "$")
    D2Pos = InStr(D1Pos + 1, ActiveSheet.PageSetup.PrintArea, "$")
    D3Pos = InStr(D2Pos + 1, ActiveSheet.PageSetup.PrintArea, "$")
    D4Pos = InStr(D3Pos + 1, ActiveSheet.PageSetup.PrintArea, "$")
    
    PA = ActiveSheet.PageSetup.PrintArea
    
    PA1 = Mid(ActiveSheet.PageSetup.PrintArea, D1Pos + 1, D2Pos - D1Pos - 1)
    PA2 = Mid(ActiveSheet.PageSetup.PrintArea, D3Pos + 1, D4Pos - D3Pos - 1)
    PA = Replace(PA, PA1, GetNextColumn(PA1))
    PA = Replace(PA, PA2, GetNextColumn(PA2))
    
    ActiveSheet.PageSetup.PrintArea = PA
End Sub
 
Function OffsetC1(ByVal R1C1In As String)
Dim OrigCNo As Integer, R1C1Out As String
 
OrigCNo = Mid(R1C1In, InStr(1, R1C1In, "C") + 1)
OffsetC1 = Replace(R1C1In, "C" & OrigCNo, "C" & OrigCNo + 1)
 
End Function
Function GetNextColumn(ByVal InChar As String) As String
 
Dim ExcelColumns As Variant
Dim i As Integer
Dim GotChar As Boolean
On Error GoTo GetNextColumn_Err
 
GotChar = False
    
InChar = UCase(InChar)
ExcelColumns = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
"AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ", "AK", "AL", "AM", "AN", "AO", "AP", "AQ", "AR", "AS", "AT", "AU", "AV", "AW", "AX", "AY", "AZ", _
"BA", "BB", "BC", "BD", "BE", "BF", "BG", "BH", "BI", "BJ", "BK", "BL", "BM", "BN", "BO", "BP", "BQ", "BR", "BS", "BT", "BU", "BV", "BW", "BX", "BY", "BZ", _
"CA", "CB", "CC", "CD", "CE", "CF", "CG", "CH", "CI", "CJ", "CK", "CL", "CM", "CN", "CO", "CP", "CQ", "CR", "CS", "CT", "CU", "CV", "CW", "CX", "CY", "CZ", _
"DA", "DB", "DC", "DD", "DE", "DF", "DG", "DH", "DI", "DJ", "DK", "DL", "DM", "DN", "DO", "DP", "DQ", "DR", "DS", "DT", "DU", "DV", "DW", "DX", "DY", "DZ", _
"EA", "EB", "EC", "ED", "EE", "EF", "EG", "EH", "EI", "EJ", "EK", "EL", "EM", "EN", "EO", "EP", "EQ", "ER", "ES", "ET", "EU", "EV", "EW", "EX", "EY", "EZ", _
"FA", "FB", "FC", "FD", "FE", "FF", "FG", "FH", "FI", "FJ", "FK", "FL", "FM", "FN", "FO", "FP", "FQ", "FR", "FS", "FT", "FU", "FV", "FW", "FX", "FY", "FZ", _
"GA", "GB", "GC", "GD", "GE", "GF", "GG", "GH", "GI", "GJ", "GK", "GL", "GM", "GN", "GO", "GP", "GQ", "GR", "GS", "GT", "GU", "GV", "GW", "GX", "GY", "GZ", _
"HA", "HB", "HC", "HD", "HE", "HF", "HG", "HH", "HI", "HJ", "HK", "HL", "HM", "HN", "HO", "HP", "HQ", "HR", "HS", "HT", "HU", "HV", "HW", "HX", "HY", "HZ", _
"IA", "IB", "IC", "ID", "IE", "IF", "IG", "IH", "II", "IJ", "IK", "IL", "IM", "IN", "IO", "IP", "IQ", "IR", "IS", "IT", "IU", "IV")
 
i = 0
    Do While GotChar = False
        If ExcelColumns(i) = InChar Then
            GotChar = True
        Else
            i = i + 1
        End If
    Loop
    GetNextColumn = ExcelColumns(i + 1)
'End If
 
GetNextColumn_Exit:
    Exit Function
 
GetNextColumn_Err:
    
    If Err.Number = 9 Then
        Select Case InChar
            Case Is = ""
                MsgBox "Valid character required"
                GetNextColumn = ""
            Case Is = "IV"
                MsgBox "This is the last available column header (IV)"
                GetNextColumn = "IV"
            Case Else
               MsgBox "Invalid Excel column header " & InChar
               GetNextColumn = ""
        End Select
        Resume GetNextColumn_Exit
    Else
        MsgBox Err.Description
        Resume GetNextColumn_Exit
    End If
End Function
Start your 7 day free trial to see this answer
Answered By: rorya
Expert Since: 04/19/2006
Accepted Solutions: 4701
Computer Expertise: Advanced
rorya has been an Expert for 2 years 8 months, during which he has posted 15117 comments and answered 4701 questions. rorya is just one of 373 experts in the Automation Zone. 1 expert collaborated on this answer, which was graded an "A" by the asker.
 
 
Related Solutions
Keywords: vba, macro, macro, chart, amend, kindli, everytim
# Title
1 Updating a chart using a Macro
2 VBA Chart Format Data Series
3 Microsoft, Excel, 2007, VBA M…
4 Call a Macro after pivot chart changes
5 Amend Userform Macro
6 Excel Macro
 
 
20081119-EE-VQP-48 / EE_QW_2_20070628