Changing Bar Color Based on Value on X-axis (XValue)

Bajan

New Member
Joined
Feb 21, 2016
Messages
36
Hi, I need some help with this one.

I have the following code below which is working fine except that it is giving me an error when I try to change the color of a specific bar based on the value on the x axis. I want that if the xValue is equal to the cell value in the worksheet, the color changes.

Th error I am getting is:
Run-time error '451':
Property let procedure not defined and property get procedure did not return an objec


The error is occurring at the line:
If .XValues(iPoint) = wsCDC.Range("E17").Value Then


Code
Private Sub cmdAveChart_Click()
Dim wsCDC As Worksheet, wsDoc As Worksheet, wsItem As Worksheet
Dim myChtObj As ChartObject
Dim rngChtData As Range
Dim rngChtXVal As Range
Dim iColumn As Long
Dim Chrtname As String, lookfor As String, myMonthYear As String
Dim nbrMonth As Integer, i As Integer, j As Integer
Dim strRange As String, strTitle As String
Dim strColumn1 As String, strColumn2 As String
Dim intColumn1 As Long
Dim intLeft As Long, intWidth As Long, intTop As Long, intHeight As Long
Dim lrCDC As Long, lrCDC2 As Long
Dim c As Chart
Dim s As Series
Dim iPoint As Long, nPoint As Long

If eodTask = False Then
If MsgBox("Charts creation is normally done via the EOM process. " & Chr(13) & Chr(13) & _
"Are you sure you want to execute this function now?", vbYesNo + vbCritical, "Warning!!") = vbYes Then
' continue with process
Else
' do not continue with process
Exit Sub
End If
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set wsDoc = ThisWorkbook.Worksheets("Daily OSM Checklist")
Set wsCDC = ThisWorkbook.Worksheets("COB Duration Chart")

'Set c = ActiveChart
'Set s = c.SeriesCollection(1)

wsDoc.Unprotect password:="ABR"
wsCDC.Unprotect password:="ABR"

' find last row in Daily OSM Checklist
lrCDC = wsCDC.Cells(Rows.Count, "A").End(xlUp).Row
lrCDC2 = lrCDC - 12

j = 3

'copy last 13 months
For i = lrCDC2 To lrCDC Step 1
wsCDC.Range("D" & j).Value = wsCDC.Range("A" & i).Value
wsCDC.Range("E" & j).Value = wsCDC.Range("B" & i).Value
j = j + 1
Next i

'sort column
wsCDC.Sort.SortFields.Clear
Call wsCDC.Sort.SortFields.Add(wsCDC.Columns(5), , xlAscending)
Call wsCDC.Sort.SetRange(wsCDC.Range("D3:E15"))
wsCDC.Sort.Apply

Application.DisplayAlerts = False

For Each wsItem In ThisWorkbook.Worksheets
For Each myChtObj In wsItem.ChartObjects
myChtObj.Delete
Next
Next
Application.DisplayAlerts = True
wsCDC.Activate
'initialize variables
nbrMonth = Month(wsDoc.Range("B3"))
myMonthYear = MonthName(nbrMonth, True) & "-" & Right(Year(wsDoc.Range("B3")), 2)

strTitle = wsCDC.Range("D1")
Chrtname = strTitle
strColumn1 = wsCDC.Range("D2")
strColumn2 = wsCDC.Range("E2")
intColumn1 = 2
intLeft = 300
intWidth = 700
intTop = 10
intHeight = 400
'make sure a range is selected
If TypeName(Selection) <> "Range" Then Exit Sub
' define chart data
Set rngChtData = wsCDC.Range("D2:E15")
' define chart's X values
With rngChtData
Set rngChtXVal = .Columns(1).Offset(1).Resize(.Rows.Count - 1) 'first column in range
End With
' add the chart
Set myChtObj = ActiveSheet.ChartObjects.Add _
(Left:=intLeft, Width:=intWidth, Top:=intTop, Height:=intHeight)
With myChtObj.Chart
' make an XY chart
.ChartType = xlColumnClustered
'chart name
.HasTitle = True
.ChartTitle.Text = Chrtname
.ChartTitle.Font.Size = 12
.ChartTitle.Font.Color = vbBlack
'X axis name
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = wsCDC.Range("D2")
'y-axis name
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = wsCDC.Range("E2")
.ChartArea.Format.Fill.ForeColor.RGB = RGB(0, 255, 0)
'With wsCDC.ChartObjects(1).Chart.PlotArea.Format.Fill
'.Visible = msoFalse
'.Visible = msoTrue
'.TwoColorGradient msoGradientHorizontal, 1
'.ForeColor.RGB = RGB(255, 255, 0)
'.BackColor.RGB = RGB(0, 176a1zq, 240)
'End With
.HasDataTable = True
.DataTable.HasBorderOutline = True
.HasLegend = False
' remove extra series
Do Until .SeriesCollection.Count = 0
.SeriesCollection(1).Delete
Loop
' add series from selected range, column by column
For iColumn = 2 To rngChtData.Columns.Count
With .SeriesCollection.NewSeries
.Values = rngChtXVal.Offset(, iColumn - 1)
.XValues = rngChtXVal
.Name = rngChtData(1, iColumn)
End With
Next

With .SeriesCollection(1)
.Name = wsCDC.Range("E2")
.Format.Fill.ForeColor.RGB = RGB(0, 0, 255)
End With

With .SeriesCollection(1)
nPoint = .Points.Count
For iPoint = 1 To nPoint
If .XValues(iPoint) = wsCDC.Range("E17").Value Then
.Points(iPoint).Interior.Color = RGB(255, 0, 0)
End If
Next iPoint
End With

End With
wsCDC.Range("A1").Activate
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
wsDoc.Activate
Set wsDoc = Nothing
Set wsCDC = Nothing
End Sub

Thanks for your help.
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Forum statistics

Threads
1,214,867
Messages
6,122,002
Members
449,059
Latest member
mtsheetz

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top