# Edit code to fix out of stack space error

#### Certified

##### Board Regular
The code below used to work, but now I am getting an error (out of stack space).

The code calculates ownership percentages up an ownership tree.

For instance:
Company 11394 is owned 75% by 10528 and 25% by 50729.
Company 10528 is owned 25% by 37124, 25% by 21133 and 50% by 11488.
Company 50729 is owned 50% by 10210 and 25% by 23196 and 25% by and outside party.

Therefore the 11394's ownership % is 93.75% (25% * .75 of 50729 branch) + (100% of 10528 branch).

These calculations (branches of the tree) can run deep.

Now it seems like they may run too deep. My code is failing because of too many recursions.

My problem is I don't know how to fix it. Recursions was the only way I can get the code to work.

I was wondering if anyone has any suggestions or an alternative way to write it.

Thanks.

Code:
``````Public entities As New DictionaryPublic MainArray() As Variant

Const colEntity As Integer = 1   ' Assumed column A
Const colParent As Integer = 3   ' Assumed column C
Const colPct As Integer = 5      ' Assumed column E
Const colInside As Integer = 6   ' Assumed column F

Sub Calculepickup()

Dim wb As Workbook
Dim ws As Worksheet

Sheet1.Activate

Dim G As Integer, r As Integer, m As Integer
Dim Mainrange As Range

m = Cells(Rows.count, "A").End(xlUp).Row
Set Mainrange = Range("a2:J" & m)
MainArray() = Mainrange

For G = 1 To UBound(MainArray, 1)
If Not entities.Exists(MainArray(G, colEntity)) Then
End If
If Not entities.Exists(MainArray(G, colParent)) Then
If MainArray(G, colInside) = "No" Then
'If the entity isn't "inside" store the fact that it is 0% owned
Else
End If
End If
Next

r = 2
For Each e In entities.Keys

CalculatePct e

Next

Dim fm As Integer

Cells(1, 14) = "GEMS ID"
Cells(1, 15) = "Parent GEMS"
Cells(1, 16) = "Pick-UP %"

For fm = 1 To UBound(MainArray)

Cells(fm + 1, 14) = MainArray(fm, 1)
Cells(fm + 1, 15) = MainArray(fm, 2)
Cells(fm + 1, 16) = Round((entities(MainArray(fm, 1)) * 100), 2)

Next fm

Cells(36, "g") = "Last updated: " & DateValue(Now) & " " & TimeValue(Now)

Debug.Print "Done"

End Sub

Sub CalculatePct(e As Variant)
Dim G As Integer
Dim pct As Double
Dim Owned100Pct As Boolean
If entities(e) < 0 Then

pct = 0
Owned100Pct = True

For G = 1 To UBound(MainArray, 1)

If MainArray(G, colEntity) = e Then

Owned100Pct = False

If entities(MainArray(G, colParent)) = -1 Then

[COLOR=#ff0000][B] CalculatePct MainArray(G, colParent)[/B][/COLOR]

End If

pct = pct + CDbl(MainArray(G, colPct)) / 100 * entities(MainArray(G, colParent))

End If
Next

If Owned100Pct Then

entities(e) = 1
Else
'Store the entity's percentage
entities(e) = pct

End If
End If

End Sub``````

### Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
You have several variables declared as integers which can only be within -32,768 to 32,767

If they fall outside of these boundaries they will error. I haven't read all your code but that's where I'd start

Thanks. I changed the variables to Long and I still getting the error.

Just realised that the sub calls itself. Is this correct? It's rarely a good option

Replies
6
Views
456
Replies
3
Views
2K
Replies
3
Views
972
Replies
4
Views
445
Replies
1
Views
399

1,207,401
Messages
6,078,262
Members
446,324
Latest member
JKamlet

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

### Which adblocker are you using?

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

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