Convert output from vertical to horizontal please.

S.H.A.D.O.

S.H.A.D.O.

Well-known Member
Joined
Sep 6, 2005
Messages
1,915
Good morning,

I have the following code which lists the output vertically, but I would like it to list the output horizontally please.
The first figure is the total Odd numbers for position 1, the second figure is the total Even numbers for position 1, and the third figure is the total Odd & Even numbers for position 1, and so on down for positions 2 to 6.

The information is output like so...

[TABLE="width: 48"]
<tbody>[TR]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]16044
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]11088
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13188
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13944
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13608
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13524
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13608
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13524
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13188
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]13944
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]16044
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]11088
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
</tbody>[/TABLE]

...but I would like it like so...

[TABLE="width: 288"]
<tbody>[TR]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]16044
[/TD]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]13188
[/TD]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]13608
[/TD]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]13608
[/TD]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]13188
[/TD]
[TD="class: xl65, width: 64, bgcolor: transparent, align: right"]16044
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]11088
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]13944
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]13524
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]13524
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]13944
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]11088
[/TD]
[/TR]
[TR]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[TD="class: xl65, bgcolor: transparent, align: right"]27132
[/TD]
[/TR]
</tbody>[/TABLE]

Here is the code...

Code: 
Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 59
Sub Odd_And_Even_By_Position()
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
    Dim nDist(1 To 18) As Double
    Dim n As Integer
    Dim i As Integer
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Columns("A:C").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
                            nDist(2 - (A Mod 2)) = nDist(2 - (A Mod 2)) + 1
                            nDist(5 - (B Mod 2)) = nDist(5 - (B Mod 2)) + 1
                            nDist(8 - (C Mod 2)) = nDist(8 - (C Mod 2)) + 1
                            nDist(11 - (D Mod 2)) = nDist(11 - (D Mod 2)) + 1
                            nDist(14 - (E Mod 2)) = nDist(14 - (E Mod 2)) + 1
                            nDist(17 - (F Mod 2)) = nDist(17 - (F Mod 2)) + 1
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    For i = 1 To 6
        nDist(i * 3) = nDist(i * 3 - 1) + nDist(i * 3 - 2)
    Next i
    For n = LBound(nDist) To UBound(nDist)
        ActiveCell.Offset(n - LBound(nDist), 1) = nDist(n)
    Next n
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Any help will be appreciated, thanks in advance.
 
Last edited:
Sort by date Sort by votes
Last correct sentence (i made a typo and discovered it after edit time expiration)

Doing inference we think about mean and variance to evaluate a fork around mean. It's hard to find something about the extreme tails of a distribution...
 
Last edited:
Upvote 0

Excel Facts

How to total the visible cells?
From the first blank cell below a filtered data set, press Alt+=. Instead of SUM, you will get SUBTOTAL(9,)
B___P said:
The common is: numbers have no memory. My favourite answer is "If they have no memory the risk is they forget statistics too".
Click to expand...
I like your answer :beerchug: .

Thanks for the name, I will Google it latter and have a read, it sounds like food for thought will be needed.

As far as coding is concerned, as I said, I try and use the lottery to learn VBA.
I think this afternoon I will try from scratch to rewrite the original code I posted because I am sure there is a way the code can be made a lot simpler than the code I have at the moment. I think what is throwing it out is the code within the 6 main For...Next loops.

Thanks again B___P, it is appreciated.
 
Upvote 0
Well, this is what I have come up with, needless to say it doesn't work because it falls over on the line...

Code: 
 If B Mod 2 = ModType1 Then nDist1(lTemp, 2) = nDist1(lTemp, 2) + 1

Here is the full code...

Code: 
Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 59
Sub Odd_And_Even_By_Position_New()
    Const ModType1 As Integer = 0
    Const ModType2 As Integer = 1
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
    Dim nDist1() As Long
    Dim nDist2() As Long
    Dim i As Integer, j As Integer
    Dim n As Long, lTemp As Long
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Cells.Delete
    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
                            lTemp = 1 + Int(A / 10)
                            If A Mod 2 = ModType1 Then nDist1(lTemp, 1) = nDist1(lTemp, 1) + 1
                            lTemp = 1 + Int(B / 10)
                            If B Mod 2 = ModType1 Then nDist1(lTemp, 2) = nDist1(lTemp, 2) + 1
                            lTemp = 1 + Int(C / 10)
                            If C Mod 2 = ModType1 Then nDist1(lTemp, 3) = nDist1(lTemp, 3) + 1
                            lTemp = 1 + Int(D / 10)
                            If D Mod 2 = ModType1 Then nDist1(lTemp, 4) = nDist1(lTemp, 4) + 1
                            lTemp = 1 + Int(E / 10)
                            If E Mod 2 = ModType1 Then nDist1(lTemp, 5) = nDist1(lTemp, 5) + 1
                            lTemp = 1 + Int(F / 10)
                            If F Mod 2 = ModType1 Then nDist1(lTemp, 6) = nDist1(lTemp, 6) + 1
                            
                            lTemp = 1 + Int(A / 10)
                            If A Mod 2 = ModType2 Then nDist2(lTemp, 1) = nDist2(lTemp, 1) + 1
                            lTemp = 1 + Int(B / 10)
                            If B Mod 2 = ModType2 Then nDist2(lTemp, 2) = nDist2(lTemp, 2) + 1
                            lTemp = 1 + Int(C / 10)
                            If C Mod 2 = ModType2 Then nDist2(lTemp, 3) = nDist2(lTemp, 3) + 1
                            lTemp = 1 + Int(D / 10)
                            If D Mod 2 = ModType2 Then nDist2(lTemp, 4) = nDist2(lTemp, 4) + 1
                            lTemp = 1 + Int(E / 10)
                            If E Mod 2 = ModType2 Then nDist2(lTemp, 5) = nDist2(lTemp, 5) + 1
                            lTemp = 1 + Int(F / 10)
                            If F Mod 2 = ModType2 Then nDist2(lTemp, 6) = nDist2(lTemp, 6) + 1
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    ActiveCell.Offset(1, 1).Resize(UBound(nDist1), UBound(nDist1, 2)).Value = nDist1
    ActiveCell.Offset(2, 1).Resize(UBound(nDist2), UBound(nDist2, 2)).Value = nDist2
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

Thanks in advance.
 
Upvote 0
give this a try

Code: 
Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 59
Sub Odd_And_Even_By_Position()
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
    Dim nDist(1 To 18) As Long
    Dim addAO As Long
    Dim addAE As Long
    Dim addBO As Long
    Dim addBE As Long
    Dim addCO As Long
    Dim addCE As Long
    Dim addDO As Long
    Dim addDE As Long
    Dim addEO As Long
    Dim addEE As Long
    
    Dim n As Integer
    
    Dim i As Integer
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Columns("A:C").ClearContents
    Cells(1, 2).Select
    For A = MinA To MaxF - 5
    addAO = IIf(A Mod 2 = 1, 1, 0)
    addAE = IIf(A Mod 2 = 0, 1, 0)
        For B = A + 1 To MaxF - 4
        addBO = IIf(B Mod 2 = 1, 1, 0)
        addBE = IIf(B Mod 2 = 0, 1, 0)
            For C = B + 1 To MaxF - 3
            addCO = IIf(C Mod 2 = 1, 1, 0)
            addCE = IIf(C Mod 2 = 0, 1, 0)
                For D = C + 1 To MaxF - 2
                addDO = IIf(D Mod 2 = 1, 1, 0)
                addDE = IIf(D Mod 2 = 0, 1, 0)
                    For E = D + 1 To MaxF - 1
                    addEO = IIf(E Mod 2 = 1, 1, 0)
                    addEE = IIf(E Mod 2 = 0, 1, 0)
                        For F = E + 1 To MaxF
                       
                        nDist(1) = nDist(1) + addAO
                        nDist(2) = nDist(2) + addAE
                        nDist(3) = nDist(3) + 1
                        
                        nDist(4) = nDist(4) + addBO
                        nDist(5) = nDist(5) + addBE
                        nDist(6) = nDist(6) + 1
                        
                        nDist(7) = nDist(7) + addCO
                        nDist(8) = nDist(8) + addCE
                        nDist(9) = nDist(9) + 1
                        
                        nDist(10) = nDist(10) + addDO
                        nDist(11) = nDist(11) + addDE
                        nDist(12) = nDist(12) + 1
                        
                        nDist(13) = nDist(13) + addEO
                        nDist(14) = nDist(14) + addEE
                        nDist(15) = nDist(15) + 1
                        
                        nDist(16) = nDist(16) + IIf(F Mod 2 = 1, 1, 0)
                        nDist(17) = nDist(17) + IIf(F Mod 2 = 0, 1, 0)
                        nDist(18) = nDist(18) + 1
                        
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    For i = 1 To 6
        nDist(i * 3) = nDist(i * 3 - 1) + nDist(i * 3 - 2)
    Next i
    For n = LBound(nDist) To UBound(nDist)
        ActiveCell.Offset(IIf(n Mod 3 = 0, 3, n Mod 3), Int(n / 3) - IIf(n Mod 3 = 0, 1, 0)) = nDist(n)
        'ActiveCell.Offset(n - LBound(nDist), 1) = nDist(n)
        
    Next n
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

The goal was not to avoid MOD at all, but at every loop you already know for the leftmost numbers if they are odd or even so I put the check at the beginning of each loop. This way MOD is not calculated when unnecessary.

Hope this will boost speed at least a little.
 
Upvote 0
Thanks for the time and effort you have put into this B___P, it is most appreciated.

I ran a time test on the code below and it ran in 22 seconds, and your code above ran in 49 seconds.
I like the logic and the way your code is written, the theory is something I can accomodate in future coding, thank you.

Code: 
Option Explicit
Option Base 1
Const MinA As Integer = 1
Const MaxF As Integer = 59
Sub Odd_And_Even_By_Position()
    Dim A As Long, B As Long, C As Long, D As Long, E As Long, F As Long
    Dim nDist(1 To 18) As Double
    Dim MyTitles1 As Variant, MyTitles2 As Variant
    Dim n As Integer
    Dim i As Integer, j As Integer
    With Application
        .ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False
    End With
    Cells.Delete
    Cells(1, 2).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
                            nDist(2 - (A Mod 2)) = nDist(2 - (A Mod 2)) + 1
                            nDist(5 - (B Mod 2)) = nDist(5 - (B Mod 2)) + 1
                            nDist(8 - (C Mod 2)) = nDist(8 - (C Mod 2)) + 1
                            nDist(11 - (D Mod 2)) = nDist(11 - (D Mod 2)) + 1
                            nDist(14 - (E Mod 2)) = nDist(14 - (E Mod 2)) + 1
                            nDist(17 - (F Mod 2)) = nDist(17 - (F Mod 2)) + 1
                        Next F
                    Next E
                Next D
            Next C
        Next B
    Next A
    For i = 1 To 6
        nDist(i * 3) = nDist(i * 3 - 1) + nDist(i * 3 - 2)
    Next i
    For n = LBound(nDist) To UBound(nDist)
'       ActiveCell.Offset(n - LBound(nDist), 1) = nDist(n)
        ActiveCell.Offset(IIf(n Mod 3 = 0, 3, n Mod 3), Int(n / 3) - IIf(n Mod 3 = 0, 1, 0)) = nDist(n)
    Next n
    With Application
        .DisplayAlerts = True: .Calculation = xlCalculationAutomatic: .ScreenUpdating = True
    End With
End Sub

I think we have spent enough time on this, it produces the correct answers, which is ultimately the goal, thank you very much for this.

Good luck tonight on the lottery and enjoy the rest of your weekend.
I will be watching the The Auckland Darts Masters 2016 here in the UK on ITV4.
And by the way, I REALLY DO BELIEVE :outtahere: .
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
create fixtures but 2 vs 2
Replies
7
Views
151
kerm007
K
P
  • Solved
Lambda to count pairs and output array based on criteria
2
Replies
19
Views
498
Phantom1
P
M
  • Question Question
Macro to change data from vertically to horizontally
Replies
4
Views
152
Mussa
M
J
  • Question Question
Combining VBA code together...need help!
Replies
3
Views
378
Fluff
Fluff
J
  • Question Question
Automatically move cells from one sheet to another based on criteria using VBA
Replies
5
Views
709
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,277
Messages
6,171,150
Members
452,383
Latest member
woodsfordg

Share this page

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