Splitting 2 Columns into 4 columns each

[Gdk224]

Hello,

I am looking to take two columns of data (A – Name, B –Number) that are around 130 rows each and split them into four even columnseach. (Ex: A,B A,B A,B A,B).I’ve looked around and found some VBA scripts that can split a single columninto many columns, but am unsure about how to do this with two columns. The twocolumns do correspond with each other and do need to stay matched up as well.

Any help or suggestions are appreciated. Thanks!

Here is the single column script I had found elsewhere.



Sub SplitInto15CellsPerColumn()
Dim X As Long, LastRow As Long, vArrIn As Variant, vArrOut As Variant
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
vArrIn = Range("A1:A" & LastRow)
ReDim vArrOut(1 To 15, 1 To Int(LastRow / 15) + 1)
For X = 0 To LastRow - 1
vArrOut(1 + (X Mod 15), 1 + Int(X / 15)) = vArrIn(X + 1, 1)
Next
Range("B1").Resize(15, UBound(vArrOut, 2)) = vArrOut
End Sub

 

[Fluff]

How about

Sub Gdk224()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, rr As Long, cc As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   r = Application.RoundUp(UBound(Ary) / 4, 0)
   ReDim Nary(1 To r, 1 To 8)
   cc = 1
   For r = 1 To UBound(Ary)
      rr = rr + 1
      Nary(rr, cc) = Ary(r, 1)
      Nary(rr, cc + 1) = Ary(r, 2)
      If rr = UBound(Nary) Then
         rr = 0: cc = cc + 2
      End If
   Next r
   Range("C1").Resize(UBound(Nary), 8).Value2 = Nary
End Sub

 

[Gdk224]

Wow! From what I can tell, that seems to be exactly what I was looking for. Thank you so much!

 

[Gdk224]

Sorry, I am not sure how to edit my previous reply. Is there any easy ways of keeping the formatting from the previous text used in this? If not, that is perfectly fine and I am thankful for your help.

 

[Fluff]

To keep the format try

Sub Gdk224_2()
   Dim i As Long, UsdRws As Long, Rws As Long, c As Long
   
   UsdRws = Range("A" & Rows.Count).End(xlUp).Row
   Rws = Application.RoundUp(UsdRws / 4, 0)
   c = 1
   For i = Rws + 1 To UsdRws Step Rws
      c = c + 2
      Range("A" & i).Resize(Rws, 2).Cut Cells(1, c)
   Next i
End Sub

 

[Gdk224]

Hmm...The second one does keep the text size and coloring of the cells, but does not seem to keep the cell size the same like the first one you posted. Would there be any ways to fix that? Basically the names are now taking up two lines (not cells) which is making the cells a bit taller than originally with the name all on one line. Thanks again.

 

[Fluff]

Just autofit the columns