VB and VBA Users Source Code: Excel: offset the series of a chart
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Excel: offset the series of a chart
By:
Erik Nordlund
Email (spam proof):
Email the originator of this post
Date:
Sunday, July 20, 2003
Hits:
1260
Category:
Unspecified
Article:
The Code below is my contribution to this site that i have read extensively in the past. Thanks for helping me to learn VBA! I wrote this to help speed up data analysis using excel. I use some pretty advanced charts and got tired of making them anew for every new set of data. so with this code i now copy a template chart into my workbook and "redirect" the series to the desired data area. It's a pretty powerful method, once you get used to the idea of not making a new chart every time, but instead using a collection of templates. Option Explicit 'Purpose : Changes what data is referenced by a chart. ' You can search and replace in the series descriptor, ' i.e. change a chart with data on the sheet "My_sheet_one" into a ' chart with data on "My_other_sheet". ' You can also move the area referenced by a row and column offset ' i.e. change a chart with data in the first three rows into one ' with data on the tenth to thirteenth rows. ' I often use this to mass-produce advanced sheets - i make one, copy ' it (even across workbooks) and then change what data it contains. ' 'Inputs : Chartname The name of the chart to process. ' [txtSearch] The text to find. ' [txtReplace] The text to insert instead of txtSearch ' [txtRowOffset] The number of rows to move the data area ' [txtColOffset] The number of columns to move the data area ' [ChkEach] if true it will ask before processing ' each series. ' ' 'Outputs : None. 'Author : Erik Nordlund 'Date : 03/07/2003 ' 'Known bugs/limitations : Only handles integer row numbers. (should be long) ' No error control ' Does not work on charts embedded into sheets ' fails on some bar charts because they have a different ' pattern in the "=SERIES()" expression. (fixable) ' Does not consider error bars. ' If a series ends up in an empty area it will disappear. ' 'Notes : Originally written in Swedish, some variable names ' may be strange. 'Revisions : Function SearchReplaceInChart(Chartname as string,_ optional txtSearch as string = "", optional txtReplace as string ="", _ optional txtRowOffset as string ="", optional txtColOffset as string="", _ optional ChkEach as boolean = false ) Dim CurrentChart As Chart Set CurrentChart = ActiveWorkbook.charts(Chartname) Dim i As Integer Dim tempstring As String For i = CurrentChart.SeriesCollection.Count To 1 Step -1 If txtSearch<> "" Then tempstring = Replace(CurrentChart.SeriesCollection(i).Formula, txtSearch, txtReplace, , , vbTextCompare) Else tempstring = CurrentChart.SeriesCollection(i).Formula End If If txtRowOffset <> "" And txtColOffset <> "" Then tempstring = offsetadresses(tempstring, CInt(txtRowOffset), CInt(txtColOffset)) End If If ChkEach = True Then If MsgBox("Should the series " & CurrentChart.SeriesCollection(i).Name & " be processed?", vbYesNo, "Search and replace in Charts") = vbYes Then CurrentChart.SeriesCollection(i).Formula = tempstring End If Else CurrentChart.SeriesCollection(i).Formula = tempstring End If Next i End Sub private Function offsetadresses(tempstring As String, rowoffset, coloffset) As String Dim temprange As Range Dim Start1range As Integer Dim len1range As Integer Dim Start2range As Integer Dim len2range As Integer Dim Start3range As Integer Dim len3range As Integer Dim range1string As String Dim range2string As String Dim range3string As String 'make an ofset in a string of this type: '=SERIES(temp!$E$5,temp!$D$11:$D$51,temp!$E$11:$E$51,8) Start1range = firstoccurance("!", tempstring, 1) + 1 len1range = firstoccurance(",", tempstring, Start1range) - Start1range range1string = Mid(tempstring, Start1range, len1range) Start2range = firstoccurance("!", tempstring, Start1range) + 1 len2range = firstoccurance(",", tempstring, Start2range) - Start2range range2string = Mid(tempstring, Start2range, len2range) Start3range = firstoccurance("!", tempstring, Start2range) + 1 len3range = firstoccurance(",", tempstring, Start3range) - Start3range range3string = Mid(tempstring, Start3range, len3range) range1string = Worksheets(1).Range(range1string).offset(rowoffset, coloffset).Address() range2string = Worksheets(1).Range(range2string).offset(rowoffset, coloffset).Address() range3string = Worksheets(1).Range(range3string).offset(rowoffset, coloffset).Address() offsetadresses = Mid(tempstring, 1, Start1range - 1) & range1string & Mid(tempstring, Start1range + len1range, Start2range - (Start1range + len1range)) & range2string & Mid(tempstring, Start2range + len2range, Start3range - (Start2range + len2range)) & range3string & Mid(tempstring, Start3range + len3range, Len(tempstring) + 1 - (Start3range + len3range)) End Function Private Function firstoccurance(character As String, stringTOsearch As String, Optional start As Integer = 1) As Integer Dim i As Integer For i = start To Len(stringTOsearch) If Mid(stringTOsearch, i, 1) = character Then firstoccurance = i Exit Function End If Next i firstoccurance = -1 End Function
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
