Multiple columns into 2?

[TheWennerWoman]

Starting at row 1, I have 36 columns of data (AA thru BJ) which go down to row 1111 for a total of 39996 records. These are dice rolls which I need put into columns B and C (starting at row 2).

The logic is AA1 goes into B2, AB1 goes into C2, AC1 goes into B3, AD1 goes into C3. Once BJ1 has been processed this should have populated cells B2:B19 and C2:C19. We then move onto AA2 goes into B20, AB2 goes into C20 and so on.

I tried cannibalising something similar that someone kindly provided (below) but it falls over with "subscript out of range" (I think it's because that piece of code was dealing with only 1 column of data, not 36.

Any thought greatly appreciated.

Sub r_make_2_cols_from_array()
Dim Ary As Variant, Nary As Variant
   Dim r As Long, nr As Long, nc As Long
   
   Ary = Range("AA1:BJ1111").Value2
   ReDim Nary(1 To 20000, 1 To 2)
   
   For r = 1 To UBound(Ary) Step 2
      nr = nr + 1
      Nary(nr, 1) = Ary(r, 1)
      Nary(nr, 2) = Ary(r + 1, 1)
   Next r
   
   Range("B2").Resize(20000, 2).Value = Nary
'If Application.WorksheetFunction.Sum(Range("B2:C49999")) <> Application.WorksheetFunction.Sum(Range("Z2:Z40001")) Then
'    MsgBox "Something went wrong!"
'Else
'    MsgBox "Done!"
End If
End Sub

 

[Georgiboy]

Have you tried:

=WRAPROWS(TOCOL(AA1:BJ1111),2)

 

[TheWennerWoman]

Ah, sorry, this is on my home PC which is running Office 2010.

 

[Alex Blakenburg]

See if this helps:

Sub r_make_2_cols_from_array()
    Dim Ary As Variant, Nary As Variant
    Dim r As Long, nr As Long, nc As Long
    
    Dim col As Long
    Dim rng As Range
    Set rng = Range("AA1:BJ" & Cells(Rows.Count, "AA").End(xlUp).Row)
    
    Ary = rng.Value2
    ReDim Nary(1 To UBound(Ary, 1) * UBound(Ary, 2) / 2, 1 To 2)
    
    For r = 1 To UBound(Ary)
        For col = 1 To UBound(Ary, 2) Step 2
            nr = nr + 1
            Nary(nr, 1) = Ary(r, col)
            Nary(nr, 2) = Ary(r, col + 1)
        Next col
    Next r
    
    Range("B2").Resize(nr, 2).Value = Nary
    'If Application.WorksheetFunction.Sum(Range("B2:C49999")) <> Application.WorksheetFunction.Sum(Range("Z2:Z40001")) Then
    '    MsgBox "Something went wrong!"
    'Else
    '    MsgBox "Done!"
    'End If
End Sub

 

[TheWennerWoman]

Genius, many thanks, works a treat

 

[Alex Blakenburg]

Thanks for letting us know. Glad we could help.

 

[Georgiboy]

Yup I wrote something very similar, might as well show it:

Sub test()
    Dim rng As Range, var As Variant, oVar() As Variant
    Dim x As Long, y As Long, z As Long
   
    Set rng = Range("AA1:BJ1111")
    var = rng.Value
    ReDim oVar((rng.Cells.Count / 2) - 1, 1)

    For x = 1 To UBound(var)
        For y = 1 To UBound(var, 2) Step 2
            oVar(z, 0) = var(x, y): oVar(z, 1) = var(x, y + 1): z = z + 1
        Next y
    Next x
   
    Range("B2").Resize(UBound(oVar) + 1, 2) = oVar
End Sub