Conditional Formatting of Charts by Value

[Luin29]

Hello everyone,

After six months of generating thousands of graphs, I am looking to automate the process. I have found a subroutine that, with some alterations, should be able to accomplish the final piece of the graph generation.

For this part of the graph generation, I would like to create a routine that will change the fill of markers in a chart based upon the values in a range. I have provide an example below:

[TABLE="width: 270"]
<tbody>[TR]
[TD="align: center"]Well ID[/TD]
[TD="align: center"]Date Sampled[/TD]
[TD="align: center"]PCE[/TD]
[TD="align: center"]Change[/TD]
[/TR]
[TR]
[TD="align: center"]VW-2[/TD]
[TD="align: center"]1/25/2008[/TD]
[TD="align: center"]ND<5.0[/TD]
[TD="align: center"]1[/TD]
[/TR]
[TR]
[TD="align: center"]VW-2[/TD]
[TD="align: center"]6/20/2008[/TD]
[TD="align: center"]5.1[/TD]
[TD="align: center"]0[/TD]
[/TR]
[TR]
[TD="align: center"]VW-2[/TD]
[TD="align: center"]9/23/2008[/TD]
[TD="align: center"]4.2[/TD]
[TD="align: center"]0[/TD]
[/TR]
[TR]
[TD="align: center"]VW-2[/TD]
[TD="align: center"]11/5/2008[/TD]
[TD="align: center"]ND<0.50[/TD]
[TD="align: center"]1[/TD]
[/TR]
</tbody>[/TABLE]

Each cell within the PCE column is evaluated in the next column to the right for text within the PCE cell and assigned is a value of 1 if text is present or 0 if not.

e.g. D2=IF(ISBLANK(C2),"",IF(ISTEXT(C2),1,0))"

The code I would like to generate would evaluate each cell within Change column and if true (Change column cell contains a 1) would then change the PCE marker in the adjacent cell fill's option change from "Solid" to "No fill".

Below are the few lines of code that I have attempted to alter for my purpose but have been unsuccessful so far:

Sub FillByValue()

  Dim rPatterns As Range
  Dim iPattern As Long
  Dim vPatterns As Variant
  Dim iPoint As Long
  Dim vValues As Variant
  Dim rValue As Range
  Dim i As Integer, j As Integer
lRow = Cells(Rows.Count, 1).End(xlUp).Row
itotalcolumns = ActiveSheet.Range("AB1").End(xlToLeft).Column
i = 3
Do While i <= itotalcolumns
    i = i + 1
ActiveSheet.ChartObjects("Chart 1").Activate
For j = 1 To ActiveChart.SeriesCollection.Count
  Set rPatterns = Range(Cells(2, i + 1), Cells(lRow, i + 1))
  vPatterns = rPatterns.Value
  With ActiveChart.SeriesCollection(j)
    vValues = .Values
    For iPoint = 1 To UBound(vValues)
      For iPattern = 1 To UBound(vPatterns)
'If D2=1 then change C2 marker fill's option to "No Fill"
        If vPatterns(iPattern).Value = 1 Then
            .Points(iPoint).Format.Fill.Visible = msoFalse
          Exit For
        End If
      Next
    Next
  End With
  i = i + 1
Next j
Loop
End Sub

Thank you very much for any help you can provide in advance. If needs be, I can provide the original code.