Is there an easyGood evening, way to condense 6 arrays into 1 please.

[S.H.A.D.O.]

Good evening,

This code does work and produces the required resilts.
Is there a way that I can condense the six rngDelta arrays into one maybe?
This will reduce the amount of code for the Dim's and for the For n...Next n loop.
This is more for interest than anything else.

Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 49
Sub List()
    Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer
    Dim rngDelta1(1 To 44) As Long, rngDelta2(1 To 44) As Long, rngDelta3(1 To 44) As Long
    Dim rngDelta4(1 To 44) As Long, rngDelta5(1 To 44) As Long, rngDelta(1 To 44) As Long
    Dim n As Integer, i As Integer
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Columns("A:G").ClearContents
    Cells(1, 1).Select
    For A = MinA To MaxF - 5
        For B = A + 1 To MaxF - 4
            For C = B + 1 To MaxF - 3
                For D = C + 1 To MaxF - 2
                    For E = D + 1 To MaxF - 1
                        For F = E + 1 To MaxF
                            rngDelta1(B - A) = rngDelta1(B - A) + 1
                            rngDelta2(C - B) = rngDelta2(C - B) + 1
                            rngDelta3(D - C) = rngDelta3(D - C) + 1
                            rngDelta4(E - D) = rngDelta4(E - D) + 1
                            rngDelta5(F - E) = rngDelta5(F - E) + 1
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    For n = LBound(rngDelta1) To UBound(rngDelta5)
        ActiveCell.Offset(n - LBound(rngDelta1), 0).Value = _
            "Total ="
        ActiveCell.Offset(n - LBound(rngDelta1), 1).Value = n
        ActiveCell.Offset(n - LBound(rngDelta1), 2).Value = rngDelta1(n)
        ActiveCell.Offset(n - LBound(rngDelta2), 3).Value = rngDelta2(n)
        ActiveCell.Offset(n - LBound(rngDelta3), 4).Value = rngDelta3(n)
        ActiveCell.Offset(n - LBound(rngDelta4), 5).Value = rngDelta4(n)
        ActiveCell.Offset(n - LBound(rngDelta5), 6).Value = rngDelta5(n)
    Next n
    For i = 1 To 5
         ActiveCell.Offset(n - 1, 2).Resize(1, i).FormulaR1C1 = "=SUM(R1C:R[-1]C)"
    Next i
    ActiveCell.Offset(n - LBound(rngDelta1), 0).Resize(n - LBound(rngDelta5), 7).EntireColumn.AutoFit
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Thanks in advance.

 

[S.H.A.D.O.]

Is there an easy way to condense 6 arrays into 1 please.

Sorry, the title got corrupted somehow, I have just corrected it. Thanks.

Edit: I just checked and that didn't seem to work, it left the Good evening in it.

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

Is this something that needs to use ReDim, and if so, how would I go about it please?

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

Has anyone got any ideas please!

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

Good afternoon,

Could I use something like...

                            rngDelta(1) = B - A
                            rngDelta(2) = C - B
                            rngDelta(3) = D - C
                            rngDelta(4) = E - D
                            rngDelta(5) = F - E

..and if so, how could I adapt the code accordingly as in post #1 please?

Thanks in advance.

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

If anyone has got any ideas that would be great!

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

If someone could point me in the right direction that would be appreciated.

 

[mancubus]

Re: Is there an easy way to condense 6 arrays into 1 please.

though i dont understand why you create 5 identical arrays and now want to combine them in one, here is a way to do that...

Sub mrxl_922130_multi1Darr_to_single2Darr()
    
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long, i As Long, calc As Long
    Dim ComArr(1 To 44, 1 To 6) As Long
    Const MinA As Long = 1, MaxF As Long = 49
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
        calc = .Calculation
        .Calculation = xlCalculationManual
    End With
    
    For A = MinA To MaxF - 5
        ComArr(A, 1) = A
        For B = A + 1 To MaxF - 4
            For C = B + 1 To MaxF - 3
                For D = C + 1 To MaxF - 2
                    For E = D + 1 To MaxF - 1
                        For F = E + 1 To MaxF
                            ComArr(B - A, 2) = ComArr(B - A, 2) + 1
                            ComArr(C - B, 3) = ComArr(C - B, 3) + 1
                            ComArr(D - C, 4) = ComArr(D - C, 4) + 1
                            ComArr(E - D, 5) = ComArr(E - D, 5) + 1
                            ComArr(F - E, 6) = ComArr(F - E, 6) + 1
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A

    Range("A1").Resize(UBound(ComArr, 1)) = "Total:"
    Range("B1").Resize(UBound(ComArr, 1), UBound(ComArr, 2)) = ComArr
    
    ActiveSheet.Columns.AutoFit

    With Application
        For i = 2 To 6
            Range("A1").Offset(UBound(ComArr, 1), i) = .Sum(.Index(ComArr, 0, i))
        Next
    
        .EnableEvents = True
        .Calculation = calc
    End With
    
End Sub

 

[S.H.A.D.O.]

Re: Is there an easy way to condense 6 arrays into 1 please.

though i dont understand why you create 5 identical arrays and now want to combine them in one, here is a way to do that...

Thanks for the reply and code mancubus, it works perfectly.

I know that the data produced in this instance is identical for all 5 arrays but the concept will be extremely useful for other tasks in the future that I wish to attempt.

Thanks again and have a great weekend!

 

[mancubus]

Re: Is there an easy way to condense 6 arrays into 1 please.

you are welcome. glad it helped.