S.H.A.D.O.
Well-known Member
- Joined
- Sep 6, 2005
- Messages
- 1,915
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.
Thanks in advance.
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.
Code:
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.