Sum cone to surface with variable size - vba

Question

I am trying to develop develop a model to calculate the sum of a cone to row 1 given an array of variable size only if the value of the cell is > 0.
If the sum is then >=1 I wish to color the range of the cone to display this. If the cone hits the A row boundary I need it not to error and for it to extend in the cone shape the other boundary. Here is what I have at the moment:
Public Sub MC()
Worksheets("SC").Cells.Clear
Dim i&, j&
For j = 1 To Worksheets("Data").Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Worksheets("Data").Cells(Rows.Count, "A").End(xlUp).Row
If Worksheets("Data").Cells(i, j) > 0 Then
Worksheets("SC").Cells(i, j).Address , SumAndColorCone(Cells(i, j))
Else: If Worksheets("Data").Cells(i, j) <= 0 Then Worksheets("SC").Cells(i, j) = "0"
End If
Next
Next
End Sub
Public Function SumAndColorCone(r As Range) As Double
Dim i&, k&, c As Range
Set c = r
For i = r.Row - 1 To 1 Step -1
If r.Column - k < 2 Then Exit For
Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
k = k + 1
Next
c.Interior.Color = vbRed
SumAndColorCone = Application.Sum(c)
End Function

Answer 1

Try this:
Public Sub MC()
Dim c&, i&, j&
For j = 1 To Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Val(Cells(i, j)) > 0 Then
c = RGB(Int(Rnd * 255) + 1, Int(Rnd * 255) + 1, Int(Rnd * 255) + 1)
Debug.Print "Testing value at: " & Cells(i, j).Address & vbLf & "Cone sum: " & SumAndColorCone(Cells(i, j), c) & vbLf
End If
Next
Next
End Sub
Private Function SumAndColorCone(r As Range, color&) As Double
Dim i&, k&, c As Range
Set c = r
For i = r.Row - 1 To 1 Step -1
If r.Column - k < 2 Then
Set c = Union(c, r(-k, -r.Column + 2).Resize(, r.Column + k + 1))
Else
Set c = Union(c, r(-k, -k).Resize(, (k + 1) * 2 + 1))
End If
k = k + 1
Next
SumAndColorCone = Application.Sum(c)
If SumAndColorCone > 1 Then c.Interior.color = color
End Function