Procedure too Large - Array calculation and Helper Array?

GeeWhiz7

Board Regular
Joined
Nov 22, 2021
Messages
214
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
I am encountering an error I don't know how to fix. My gut says I need a helper array (new to arrays in general) to achieve this, but maybe someone has a clever alternative.

Info: 'b' array gets its values from division of two array elements in 'a' array

The code below works fine unless I increase the number of calculations and then I get a Procedure too large error. My dataset needs to generate around 1200 columns in array b using this approach. I haven't figured out the syntax to do all the calculations with a loop.

Goal: Be able to make up to 1200 calculations like b(i,1) = a(i,1) / a(i,2) without running into Procedure too large error

VBA Code:
Option Explicit

Sub test()
  Dim lr As Long, a As Variant, b As Variant
  Dim i As Long, j As Long
  
  lr = Sheet3.Range("A" & Rows.Count).End(xlUp).row

  a = Sheet2.Range("B2:AY" & lr).Value2

  ReDim b(1 To UBound(a, 1), 1 To 10)
    
'##Nested loop to get cell values from array a to array b with a calculation in between
  
  For i = 1 To UBound(a)

'    For j = 1 To 50  ## not using j at the moment

        b(i, 1) = a(i, 1) / a(i, 2) 'note these calculations are representing non recursive combinations of 5 elements. ie any non repeating combinations of 1 through 5 using two #s.
        b(i, 2) = a(i, 1) / a(i, 3) ' I can't figure out how to do this with a loop
        b(i, 3) = a(i, 1) / a(i, 4) ' maybe I need some sort of helper array as if I simply put in more calculations like this (~1200)
        b(i, 4) = a(i, 1) / a(i, 5) ' eventually the procedure becomes too large even for 64bit.
        b(i, 5) = a(i, 2) / a(i, 3)
        b(i, 6) = a(i, 2) / a(i, 4)
        b(i, 7) = a(i, 2) / a(i, 5)
        b(i, 8) = a(i, 3) / a(i, 4)
        b(i, 9) = a(i, 3) / a(i, 5)
        b(i, 10) = a(i, 4) / a(i, 5)
    'Next

  Next
  Range("B2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
  
  
End Sub
 
Try:
Assume source is in sheet1
results are in sheet2
I tested with range B2:AY1400 in sheet 1, it took around <1s

VBA Code:
Option Explicit
Sub combi()
Dim lr&, i&, j&, k&, n&, count&, rng, arr()
With Worksheets("Sheet1")
    lr = .Cells(Rows.count, "A").End(xlUp).Row
    rng = .Range("B2:AY" & lr).Value
    n = UBound(rng, 2)
    ReDim arr(1 To lr - 1, 1 To n * (n - 1) / 2)
    For i = 1 To lr - 1
        count = 0
        For j = 1 To n - 1
            For k = j + 1 To n
                count = count + 1
                arr(i, count) = rng(i, k) / rng(i, j)
            Next
        Next
    Next
End With
Worksheets("Sheet2").Range("B1").Resize(UBound(arr), UBound(arr, 2)).Value = arr
End Sub
 
Upvote 0

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.
A previous attempt I made for 3D array you might want to consider.
Very interesting! Though, it's not the 3D array I mentioned.
Somthing like this
ThreeDArr(D1,D2,D3)

Your solution for 3D:
1DArr( n )
with n is series of 2D array
 
Upvote 0
My 2 cent's worth :)
You didn't specify in your code where you wanted the evaluated b array to be pasted to - so I've specified sheet1 in this code: change that to suit.

VBA Code:
Option Explicit
Sub GeeWhiz7()
    Dim a, b
    Dim lr As Long, i As Long, j As Long, k As Long, l As Long, x As Long
    
    lr = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
    a = Sheet2.Range("B2:AY" & lr).Value
    x = WorksheetFunction.Combin(UBound(a, 2), 2)
    ReDim b(1 To UBound(a, 1), 1 To x)
    
    For i = 1 To UBound(a, 1)
        For j = 1 To x
            For k = 1 To UBound(a, 2) - 1
                For l = k + 1 To UBound(a, 2)
                    b(i, j) = a(i, k) / a(i, l)
                    j = j + 1
                Next l
            Next k
        Next j
    Next i
    
    'Change sheet location to suit
    Sheet1.Range("B2").Resize(UBound(b, 1), x).Value = b
End Sub
 
Upvote 0
Solution
My 2 cent's worth :)
You didn't specify in your code where you wanted the evaluated b array to be pasted to - so I've specified sheet1 in this code: change that to suit.

VBA Code:
Option Explicit
Sub GeeWhiz7()
    Dim a, b
    Dim lr As Long, i As Long, j As Long, k As Long, l As Long, x As Long
   
    lr = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
    a = Sheet2.Range("B2:AY" & lr).Value
    x = WorksheetFunction.Combin(UBound(a, 2), 2)
    ReDim b(1 To UBound(a, 1), 1 To x)
   
    For i = 1 To UBound(a, 1)
        For j = 1 To x
            For k = 1 To UBound(a, 2) - 1
                For l = k + 1 To UBound(a, 2)
                    b(i, j) = a(i, k) / a(i, l)
                    j = j + 1
                Next l
            Next k
        Next j
    Next i
   
    'Change sheet location to suit
    Sheet1.Range("B2").Resize(UBound(b, 1), x).Value = b
End Sub
Wow...more like a nickels worth or more. I guess it never dawned on me to try to put the combinations calculation directly in and it would be a stretch for my novice array skills. I was doing that in the sheet directly then trying to apply to the array as a helper. So this is brilliant and condenses three procedures to one for me.
Thank you Kevin9999 for the final solution and JohnnyL/bebo for building to it!!
 
Upvote 0

Forum statistics

Threads
1,215,853
Messages
6,127,328
Members
449,376
Latest member
karenmccabe

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.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

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

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

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
Back
Top