Change the output of the code

[admiral100]

Hi ,


This code works fine. (Split Column A & B to 3 columns)

Sub SplitInto3CellsPerColumn()
Dim X As Long, LastRow As Long, vArrIn As Variant, vArrIn2 As Variant, vArrOut As Variant, vArrOut2 As Variant
LastRow = Cells(Rows.Count, "A").End(xlUp).Row

vArrIn = Range("A1:A" & LastRow)
vArrIn2 = Range("B1:B" & LastRow)

ReDim vArrOut(1 To 3, 1 To Int(LastRow / 3) + 1)
ReDim vArrOut2(1 To 3, 1 To Int(LastRow / 3) + 1)

For X = 0 To LastRow - 1
vArrOut(1 + (X Mod 3), 1 + Int(X / 3)) = vArrIn(X + 1, 1)
vArrOut2(1 + (X Mod 3), 1 + Int(X / 3)) = vArrIn2(X + 1, 1)
Next

Range("M1").Resize(3, UBound(vArrOut, 2)) = vArrOut
Range("M6").Resize(3, UBound(vArrOut2, 2)) = vArrOut2


End Sub



The output:

10 40 70
20 50 80
30 60 90


A D G
B E H
C F I


How should I change the code so that the output will be like this: (Odd & Even columns)

10 A 40 D 70 G
20 B 50 E 80 H
30 C 60 F 90 I

Thanks

 

[admiral100]

Any idea? Hint ?

Appreciate the help

 

[Marcelo Branco]

Maybe
delete (comment out) the two last code lines

Range("M1").Resize(3, UBound(vArrOut, 2)) = vArrOut
  Range("M6").Resize(3, UBound(vArrOut2, 2)) = vArrOut2

add these code lines

Dim varrResult() As Variant, Y As Long, Z As Long
ReDim varrResult(1 To UBound(varrOut, 1), 1 To 2 * UBound(varrOut, 2))

For X = 1 To UBound(varrResult, 1)
    Z = 0
    For Y = 1 To UBound(varrResult, 2) Step 2
        Z = Z + 1
        varrResult(X, Y) = varrOut(X, Z)
    Next Y
    Z = 0
    For Y = 2 To UBound(varrResult, 2) Step 2
        Z = Z + 1
        varrResult(X, Y) = varrOut2(X, Z)
    Next Y
Next X
        
Range("M1").Resize(UBound(varrResult, 1), UBound(varrResult, 2)) = varrResult

Hope this helps

M.

 

[admiral100]

Brilliant! works like a charm.
You are a genius from another league


Thanks for your time.

 

[Marcelo Branco]

You are very welcome. Glad to help

M.