VBA code to set custom error bars in xl2007
Here is code and example workbook on how to set Custom values for error bars in xl2007
Sub ErrorFromRange()
Dim chtTemp As Chart
Dim objSeries As Series
Dim objErrBars As ErrorBars
Dim rngUseErrors As Range
Dim rngMinusX As Range
Dim rngPlusX As Range
Dim rngMinusY As Range
Dim rngPlusY As Range
Set chtTemp = ActiveSheet.ChartObjects(1).Chart
Set objSeries = chtTemp.SeriesCollection(1)
Set rngUseErrors = Range("N1:N4")
Set rngMinusX = Range("D2:D10")
Set rngPlusX = Range("E2:E10")
Set rngMinusY = Range("F2:F10")
Set rngPlusY = Range("G2:G10")
If rngUseErrors.Cells(1, 1) Then
' -X
If rngUseErrors.Cells(2, 1) Then
' and +X
objSeries.ErrorBar xlX, xlErrorBarIncludeBoth, xlErrorBarTypeCustom, "='" & rngPlusX.Parent.Name & "'!" & rngPlusX.Address(, , xlR1C1), "'" & rngMinusX.Parent.Name & "'!" & rngMinusX.Address(, , xlR1C1)
Else
' only
objSeries.ErrorBar xlX, xlErrorBarIncludeMinusValues, xlErrorBarTypeCustom, "", "='" & rngMinusX.Parent.Name & "'!" & rngMinusX.Address(, , xlR1C1)
End If
ElseIf rngUseErrors.Cells(2, 1) Then
' +X
objSeries.ErrorBar xlX, xlErrorBarIncludePlusValues, xlErrorBarTypeCustom, "='" & rngPlusX.Parent.Name & "'!" & rngPlusX.Address(, , xlR1C1), ""
Else
objSeries.ErrorBar xlX, xlErrorBarIncludeNone, xlErrorBarTypeFixedValue
End If
If rngUseErrors.Cells(3, 1) Then
' -Y
If rngUseErrors.Cells(4, 1) Then
' and +Y
objSeries.ErrorBar xlY, xlErrorBarIncludeBoth, xlErrorBarTypeCustom, "='" & rngPlusY.Parent.Name & "'!" & rngPlusY.Address(, , xlR1C1), "='" & rngMinusY.Parent.Name & "'!" & rngMinusY.Address(, , xlR1C1)
Else
' only
objSeries.ErrorBar xlY, xlErrorBarIncludeMinusValues, xlErrorBarTypeCustom, "", "='" & rngMinusY.Parent.Name & "'!" & rngMinusY.Address(, , xlR1C1)
End If
ElseIf rngUseErrors.Cells(4, 1) Then
' +Y
objSeries.ErrorBar xlY, xlErrorBarIncludePlusValues, xlErrorBarTypeCustom, "='" & rngPlusY.Parent.Name & "'!" & rngPlusY.Address(, , xlR1C1), ""
Else
objSeries.ErrorBar xlY, xlErrorBarIncludeNone, xlErrorBarTypeFixedValue
End If
End Sub
Dim chtTemp As Chart
Dim objSeries As Series
Dim objErrBars As ErrorBars
Dim rngUseErrors As Range
Dim rngMinusX As Range
Dim rngPlusX As Range
Dim rngMinusY As Range
Dim rngPlusY As Range
Set chtTemp = ActiveSheet.ChartObjects(1).Chart
Set objSeries = chtTemp.SeriesCollection(1)
Set rngUseErrors = Range("N1:N4")
Set rngMinusX = Range("D2:D10")
Set rngPlusX = Range("E2:E10")
Set rngMinusY = Range("F2:F10")
Set rngPlusY = Range("G2:G10")
If rngUseErrors.Cells(1, 1) Then
' -X
If rngUseErrors.Cells(2, 1) Then
' and +X
objSeries.ErrorBar xlX, xlErrorBarIncludeBoth, xlErrorBarTypeCustom, "='" & rngPlusX.Parent.Name & "'!" & rngPlusX.Address(, , xlR1C1), "'" & rngMinusX.Parent.Name & "'!" & rngMinusX.Address(, , xlR1C1)
Else
' only
objSeries.ErrorBar xlX, xlErrorBarIncludeMinusValues, xlErrorBarTypeCustom, "", "='" & rngMinusX.Parent.Name & "'!" & rngMinusX.Address(, , xlR1C1)
End If
ElseIf rngUseErrors.Cells(2, 1) Then
' +X
objSeries.ErrorBar xlX, xlErrorBarIncludePlusValues, xlErrorBarTypeCustom, "='" & rngPlusX.Parent.Name & "'!" & rngPlusX.Address(, , xlR1C1), ""
Else
objSeries.ErrorBar xlX, xlErrorBarIncludeNone, xlErrorBarTypeFixedValue
End If
If rngUseErrors.Cells(3, 1) Then
' -Y
If rngUseErrors.Cells(4, 1) Then
' and +Y
objSeries.ErrorBar xlY, xlErrorBarIncludeBoth, xlErrorBarTypeCustom, "='" & rngPlusY.Parent.Name & "'!" & rngPlusY.Address(, , xlR1C1), "='" & rngMinusY.Parent.Name & "'!" & rngMinusY.Address(, , xlR1C1)
Else
' only
objSeries.ErrorBar xlY, xlErrorBarIncludeMinusValues, xlErrorBarTypeCustom, "", "='" & rngMinusY.Parent.Name & "'!" & rngMinusY.Address(, , xlR1C1)
End If
ElseIf rngUseErrors.Cells(4, 1) Then
' +Y
objSeries.ErrorBar xlY, xlErrorBarIncludePlusValues, xlErrorBarTypeCustom, "='" & rngPlusY.Parent.Name & "'!" & rngPlusY.Address(, , xlR1C1), ""
Else
objSeries.ErrorBar xlY, xlErrorBarIncludeNone, xlErrorBarTypeFixedValue
End If
End Sub
VBA Custom Error Bar code (18kb)