XY Scatter label and colouring problem

Hi, here is my first post! I hope someone can get me back on the right road with this please. Any help gratefully received.

The code should be helping label up a XY scatter chart, and colour points and text for similar items on the chart.

The routine gets into trouble where I start to set out to loop through the label process followed by the colouring stuff. (I took the label routine from the MS website).

The code snags up with a runtime error 1004 Method 'Range' of Object'_Global' failed on the line below

ReDim mylabelarray((Range(xVals).Cells.Count + 1), 4)

Here is the code. To get it working you need some data in column H and column L starting at row 40. Cell A1 should contain the row number of the end of the data. This is because the length of the data may well be different each time I want to use the chart and so by changing the ref in A1 I can adjust the chart dimensions....

Private Sub Update_Chart_Click()
Dim mymin, mymax As Integer: Dim mychart_type As String
mychart_type = Range("B34").Value
Dim myrange As String: Dim myvalue_chart As Integer
myvalue_chart = Range("A1").Value
ActiveSheet.ChartObjects("Chart 1").Activate
Select Case mychart_type
Case "One"
myrange = "='Spread Chart'!R40C8:R" & myvalue_chart & "C8"
ActiveChart.SeriesCollection(1).XValues = myrange
myrange = "='Spread Chart'!R40C12:R" & myvalue_chart & "C12"
ActiveChart.SeriesCollection(1).Values = myrange
mymin = Range("D34").Value: mymax = Range("f34").Value
Case "Two"
myrange = "='Spread Chart'!R40C8:R" & myvalue_chart & "C8"
ActiveChart.SeriesCollection(1).XValues = myrange
myrange = "='Spread Chart'!R40C13:R" & myvalue_chart & "C13"
ActiveChart.SeriesCollection(1).Values = myrange
mymin = Range("D35").Value: mymax = Range("f35").Value
End Select
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale = (mymin - 10)
.MaximumScale = (mymax + 10)
.MinorUnitIsAuto = True
.MajorUnit = 10
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
ActiveChart.Axes(xlCategory).Select
With ActiveChart.Axes(xlCategory)
.MinimumScale = IIf(Range("d36").Value - 0.5 < 0, 0, Range("d36").Value - 0.5)
.MaximumScale = Range("f36").Value + 0.5
.MinorUnit = 1
.MajorUnit = 5
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
Dim Counter As Integer, ChartName As String, xVals As String
Dim visible_counter As Integer
Application.ScreenUpdating = False
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.PlotArea.Select
xVals = ActiveChart.SeriesCollection(1).Formula
xVals = Mid(xVals, InStr(InStr(xVals, ","), xVals, Mid(Left(xVals, InStr(xVals, "!") - 1), 9)))
Do While Left(xVals, 1) = ","
xVals = Mid(xVals, 2)
Loop
Dim mycheck As String: Dim myrandom As Integer
Dim pointshape As Integer: pointshape = 0
Dim newticker As Boolean: Dim k As Integer
mycheck = " "
Dim myarrayusage As Integer: myarrayusage = 1
Dim mylength As Integer: Dim mylocation As Integer
Dim mytext As String: Dim mytext2 As String
Dim mylabelarray() As Variant
ReDim mylabelarray((Range(xVals).Cells.Count + 1), 4)
Dim mylabeltypearray() As Variant
ReDim mylabeltypearray((Range(xVals).Cells.Count + 1), 4)
Dim shapearray As Variant
shapearray = Array(xlMarkerStyleCircle, xlMarkerStyleDash, xlMarkerStyleDiamond, xlMarkerStyleSquare, xlMarkerStyleTriangle, xlMarkerStylePlus, xlMarkerStyleX, xlMarkerStyleStar)
For Counter = 1 To Range(xVals).Cells.Count
If Range(xVals).Cells.Rows(Counter).Hidden = False Then
mytext = Range(xVals).Cells(Counter, 1).Offset(0, -7).Value
mylength = Len(mytext)
mylocation = 0: mytext2 = "1"
Do Until mytext2 = mycheck
mylocation = mylocation + 1
mytext2 = Mid(mytext, mylocation, 1)
Loop
mytext = Left(mytext, mylocation)
If myarrayusage = 1 Then
newticker = True
Else
newticker = True
For k = 1 To myarrayusage
If mytext = mylabelarray(k, 0) Then
newticker = False
Exit For
End If
Next k
End If
If newticker = True Then
mylabelarray(myarrayusage, 0) = mytext
If pointshape = 7 Then
pointshape = 0
End If
mylabelarray(myarrayusage, 1) = shapearray(pointshape)
mylabeltypearray(Counter, 1) = shapearray(pointshape)
myrandom = Int((8 * Rnd))
Select Case myrandom
Case 0
mylabelarray(myarrayusage, 2) = 0
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 0
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 255
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 1
mylabelarray(myarrayusage, 2) = 0
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 255
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 0
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 2
mylabelarray(myarrayusage, 2) = 0
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 255
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 255
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 3
mylabelarray(myarrayusage, 2) = 255
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 0
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 0
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 4
mylabelarray(myarrayusage, 2) = 255
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 255
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 0
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 5
mylabelarray(myarrayusage, 2) = 255
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 102
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 0
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 6
mylabelarray(myarrayusage, 2) = 255
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 0
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 255
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 7
mylabelarray(myarrayusage, 2) = 153
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 204
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 0
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
Case 8
mylabelarray(myarrayusage, 2) = 204
mylabeltypearray(Counter, 2) = mylabelarray(myarrayusage, 2)
mylabelarray(myarrayusage, 3) = 153
mylabeltypearray(Counter, 3) = mylabelarray(myarrayusage, 3)
mylabelarray(myarrayusage, 4) = 255
mylabeltypearray(Counter, 4) = mylabelarray(myarrayusage, 4)
End Select
pointshape = pointshape + 1
myarrayusage = myarrayusage + 1
End If
If newticker = False Then
mylabeltypearray(Counter, 1) = mylabelarray((k), 1)
mylabeltypearray(Counter, 2) = mylabelarray((k), 2)
mylabeltypearray(Counter, 3) = mylabelarray((k), 3)
mylabeltypearray(Counter, 4) = mylabelarray((k), 4)
End If
End If
Next Counter
visible_counter = 1
For Counter = 1 To Range(xVals).Cells.Count
If Range(xVals).Cells.Rows(Counter).Hidden = False Then
ActiveChart.SeriesCollection(1).Points(visible_counter).HasDataLabel = True
ActiveChart.SeriesCollection(1).Points(visible_counter).HasData.Text = Range(xVals).Cells(Counter, 1).Offset(0, -7).Value
ActiveChart.SeriesCollection(1).Points(visible_counter).Select
With Selection
If mylabeltypearray(Counter, 1) = xlMakerStyleSquare Then
.MarkerBackgroundColor = RGB(CLng(mylabeltypearray(Counter, 2)), CLng(mylabeltypearray(Counter, 3)), CLng(mylabeltypearray(Counter, 4)))
'0 to 255 Red, Green Blue
ElseIf mylabeltypearray(Counter, 1) = xlMarkerStyleTriangle Then
.MarkerBackgroundColor = RGB(CLng(mylabeltypearray(Counter, 2)), CLng(mylabeltypearray(Counter, 3)), CLng(mylabeltypearray(Counter, 4)))
'0 to 255 Red, Green Blue
ElseIf mylabeltypearray(Counter, 1) = xlMarkerStyleCircle Then
.MarkerBackgroundColor = RGB(CLng(mylabeltypearray(Counter, 2)), CLng(mylabeltypearray(Counter, 3)), CLng(mylabeltypearray(Counter, 4)))
'0 to 255 Red, Green Blue
ElseIf mylabeltypearray(Counter, 1) = xlMarkerStyleDiamond Then
.MarkerBackgroundColor = RGB(CLng(mylabeltypearray(Counter, 2)), CLng(mylabeltypearray(Counter, 3)), CLng(mylabeltypearray(Counter, 4)))
'0 to 255 Red, Green Blue
Else
.MarkerBackgroundColor = RGB(255, 255, 255)
'0 to 255 Red, Green Blue
End If
.MarkerForegroundColor = RGB(CLng(mylabeltypearray(Counter, 2)), CLng(mylabeltypearray(Counter, 3)), CLng(mylabeltypearray(Counter, 4)))
'0 to 255 Red, Green Blue
.MarkerStyle = mylabeltypearray(Counter, 1)
End With
ActiveChart.SeriesCollection(1).Points(visible_counter).DataLabel.Select
Selection.AutoScaleFont = True
With Selection.Format.textframe2.textrange.Font
Select Case (Right(Range(xVals).Cells(Counter, 1).Offset(0, -7).Value, 3))
Case "XL1"
.baselineoffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 0, 240)
.Fill.Transparency = 0
.Fill.Solid
Case "XL2"
.baselineoffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(192, 0, 0)
.Fill.Transparency = 0
.Fill.Solid
Case "XL3"
.baselineoffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(0, 112, 192)
.Fill.Transparency = 0
.Fill.Solid
Case Else
.baselineoffset = 0
.Fill.Visible = msoTrue
.Fill.ForeColor.RGB = RGB(50, 50, 50)
.Fill.Transparency = 0
.Fill.Solid
End Select
End With
visible_counter = visible_counter + 1
End If
Next Counter
Range("d42").selct
Application.ScreenUpdating = True
MsgBox "Labels Updated"
End Sub

Hi Andy, thanks for the swift reply.

Can you elaborate on that a little please? How do I split up that code and still achieve the correct parameters for the two elements?

Many thanks again