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.
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.