Transpose 2 Columns Into 1 Column But Add Blank

[Lewzerrrr]

So I have a list of 40,000 values in columns A and B.. Let’s say column A runs Animal1, Animal2, Animal3 and B runs Fruit1, Fruit2, Fruit3.. What I need is a bit of code that will merge these together but add a blank row in between so it then collates in column A:
ANIMAL1
Blank
FRUIT1
ANIMAL2
Blank
FRUIT2
ANIMAL3
Blank
FRUIT3
ANIMAL4

Any help is greatly appreciated

 

[Momentman]

Assuming of course that column A and Column B have equal number of filled rows

Sub MergeAddblank()
    Dim I As Long
    For I = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        Cells(3 * I - 2, "A") = Cells(I, "A")
        Cells(3 * I - 1, "A") = ""
        Cells(3 * I, "A") = Cells(I, "B")
    Next I
End Sub

 

[Rick Rothstein]

Assuming of course that column A and Column B have equal number of filled rows

Sub MergeAddblank()
    Dim I As Long
    For I = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        Cells(3 * I - 2, "A") = Cells(I, "A")
        Cells(3 * I - 1, "A") = ""
        Cells(3 * I, "A") = Cells(I, "B")
    Next I
End Sub

You can also code the above macro without using a loop...

[table="width: 500"]
[tr]
	[td]Sub MergeAddblank()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & 3 * LR) = Application.Transpose(Split([A1&"||"] & Join(Application.Transpose(Evaluate("B1:B" & LR & "&""|""&A2:A" & LR + 1 & "&""|""")), "|"), "|"))
End Sub[/td]
[/tr]
[/table]

 

[Momentman]

You can also code the above macro without using a loop...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub MergeAddblank()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & 3 * LR) = Application.Transpose(Split([A1&"||"] & Join(Application.Transpose(Evaluate("B1:B" & LR & "&""|""&A2:A" & LR + 1 & "&""|""")), "|"), "|"))
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

How do you come up with things like this? Wouldn't mind an explanation

 

[Rick Rothstein]

How do you come up with things like this? Wouldn't mind an explanation

To tell you the truth... I am not sure. When I see a problem, the overall approach just "comes to me in a flash". For this problem... concatenate cell pairs with a delimiter so they output as an array which will then be joined using the same delimiter so that they can be split on the delimiter to produce an array. Then the various functions and manipulations to implement that overall plan follows close at hand. Here, the Evaluate function produces the array of paired cells with a delimiter on the end (so it will couple with the delimiter I'll use to join the array parts to produce a double delimiter which, in turn, will produce the blank row upon splitting), transpose the array the Evaluate produces (because it is a two dimensional array and transposing a two dimensional produced from a vertical range create a one dimensional VB array), then apply the Join function to this array (Join only works on one dimensional VB arrays) using the same delimiter that was used in the Evaluate function... this produces a text string with every cell pair having a delimiter between the cells and a double delimiter between each of those pairs... I then split this text string on the delimiter to produce a one dimensional array which I then transpose so that I can feed it to the output cells (as a vertical range). Believe it or not, all of that kind of comes to me, as I said earlier, "in a flash". I used to say that I was able to "think" in the VBA language (I have been programming in BASIC, VB and VBA since 1981, so I am intimately familiar with it), but a fellow MVP characterized it by saying that I had "internalized" a vast amount of the functions, properties and methods available in VBA... that is probably a better way to describe it. Anyway, whatever it is, that is how my mind works.

 

[Peter_SSs]

I don't think the number of lines of code matter. More important is correctness of results (& perhaps speed sometimes).(Read: Rick, you need to check your results. )

I'm also going a looping approach, but this is considerably faster than the first looping suggestion & I think that is relevant in this case due to the OPs data.

Sub CombineData()
  Dim a As Variant, b As Variant
  Dim i As Long

  a = Range("A1", Range("B" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To 3 * UBound(a), 1 To 1)
  For i = 1 To UBound(a)
    b(i * 3 - 2, 1) = a(i, 1)
    b(i * 3, 1) = a(i, 2)
  Next i
  Range("C1").Resize(UBound(b)).Value = b
End Sub

 

[Rick Rothstein]

(Read: Rick, you need to check your results. )

Darn, I missed a +1. Thanks for noting that.

Here is the corrected code for my approach...

Sub MergeAddblank()
  Dim LR As Long
  LR = Cells(Rows.Count, "A").End(xlUp).Row
  Range("C1:C" & 3 * LR [B][COLOR="#FF0000"]+ 1[/COLOR][/B]) = Application.Transpose(Split([A1&"||"] & Join(Application.Transpose(Evaluate("B1:B" & LR & "&""|""&A2:A" & LR + 1 & "&""|""")), "|"), "|"))
End Sub

 

[Peter_SSs]

Here is the corrected code for my approach...

Hmm, what's the relevance of the +1? If you have 10 rows of data why do you need 31 for the result?
Your previous code seemed to me to work fine on small data - I just don't think that you have accounted for the size of the actual data.