change display from horizontal to vertical

montecarlo2012

Well-known Member
Joined
Jan 26, 2011
Messages
986
Office Version
  1. 2010
Platform
  1. Windows
Hello.
I need assistance in modifying this code so that the results are displayed vertically instead of horizontally. Can you guide me on how to achieve this transformation?
the values on G2 will be H2:AQ2, Please.
VBA Code:
Sub Total_games_skips()
Dim Rng  As Range, Dn As Range, Rw As Range
Dim n       As Long
Dim Q As Variant
Dim Omax    As Integer, oSub As Integer

Range("G2:BB100").ClearContents

Set Rng = Range(Range("B2"), Range("B" & Rows.count).End(xlUp)).Resize(, 5)    'dynamic array of 5 columns ("B2:F")
    ReDim Ray(1 To Rng.count, 1 To 2)
    
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

For Each Rw In Rng.Rows
n = n + 1
For Each Dn In Rw.Columns

If Not .Exists(Dn.value) Then
    Ray(1, 1) = n - 1: Ray(1, 2) = n - 1
    .Add Dn.value, Array(Ray, 1)
    Else
    Q = .Item(Dn.value)
    Q(1) = Q(1) + 1
    oSub = IIf(Q(1) > 2, 1, 2)
    Q(0)(Q(1), 1) = n
    Q(0)(Q(1), 2) = n - Q(0)(Q(1) - 1, 1) - oSub
    Omax = Application.Max(Omax, Q(1))
    .Item(Dn.value) = Q
End If
Next Dn
Next Rw

Dim K As Variant
Dim R As Long
Dim c As Long
c = 1
For Each K In .Keys
c = c + 1
Cells(c, 7) = K                                                '' Column G, with the list of numbers you want to report
Cells(c, 12).Font.Bold = True                         'location for the results

For R = 1 To .Item(K)(1)
Cells(c, 12 + R) = .Item(K)(0)(R, 2)
Next R
Next K

Range("G2").Resize(.count, Omax + 5).Sort Range("G2"), xlAscending 'the bin from 1 to end
Call RwData(Range("M2").Resize(.count), Omax) ' this is the skip report starter or column 13
End With
End Sub
Sub RwData(Rng As Range, col As Integer)

Range("J1").value = "AVERAGE"
   Range("K1").value = "DEVIATION"
   Range("N1").value = "SKIP"
Range("M1").value = "OUT"
Dim Dn As Range
For Each Dn In Rng
With Application
   
   
    'Dn.Offset(, -3) = Fix(.Average(Dn.Resize(, .CountA(Dn.Resize(, col))))) 'this is colum J or 10 [or -3 from 13]
    Dn.Offset(, -3) = Round((.Average(Dn.Resize(, .CountA(Dn.Resize(, col))))), 1)
   If Dn.Offset(, -3) = Fix(Abs(Dn - .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))) Then
    Dn.Offset(, -1) = "yes"
    End If
    
    If Dn.Offset(, -2).Value2 = Fix(Abs(Dn - .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))) Then
    Dn.Offset(, -4) = "yes"
    End If
    
    
    Dn.Offset(, -2) = Fix(Abs(Dn - .Average(Dn.Resize(, .CountA(Dn.Resize(, col)))))) 'column K or -2 from 13
   
  
   
    
End With
Next Dn
End Sub
Thank you.
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
The best way is to rewrite the last part of your code (basically everything after "Dim K As Variant", as that is where the writing to the sheet happens), but that'll take some testing.

Quicker would be to add to the end something like this to transpose the result (untested, just did some quick record macro):

VBA Code:
Set ShtSrc = ActiveSheet
Set ShtTemp = Sheets.Add After:=ShtSrc
ShtSrc.Range("G1:W101").Copy
ShtTemp.Range("G1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
 
Upvote 0

Forum statistics

Threads
1,224,713
Messages
6,180,521
Members
452,986
Latest member
zenki1

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