Rearrange data without using Cut and Insert

Question

I'm fairly new to VBA, and this was basically a brute-force solution to a problem I was encountering. I wanted to take data that appeared in two columns, and pull it together into one.

The current code works, but is very slow with large datasets. I've been told to avoid using the clipboard if possible, but I'm not quite sure where to begin with this. I've made a few attempts to use an array, but I'm not quite sure where to start. Any other suggestions would be very welcome.

Private Sub Arra()
 Dim Library As Worksheet
 Set Library = Sheets("Library")
 Dim Rng As Range
 Dim i As Long
 Dim lastRow As Long
 i = 1
 lastRow = Library.Range("A1").SpecialCells(xlCellTypeLastCell).row
 While i <= lastRow
 Set Rng = Library.Range("A" & i)
 If Application.WorksheetFunction.CountA(Rng.Offset(0, 1)) = 1 Then
 Rng.Offset(0, 1).Cut
 Rng.Offset(1, 0).Insert Shift:=xlDown
 Rng.Offset(0, 1).Insert Shift:=xlDown
 ElseIf Application.WorksheetFunction.CountA(Rng.Offset(0, 1)) = 0 Then
 i = i + 1
 End If
 Wend
End Sub

• Kaz: Is there anything special about the order the new data must appear in the merged column? I.E. must it go A1 | A2 | B1 | B2 etc?
• user1996971: No, all into one column A. If anything appears in column B must go into column A, immediately below the cell to the left of it (hence the offset.insert)
• Kaz: That's what I was asking, whether you needed the data to be ordered a certain way or you could just copy/paste column B below column A ^^
• user1996971: Ha! Apologies. Short answer is yes, then! :D

Answer 1

To speed it up, I would read it into arrays. One array for column A and one array for column B and then combine them into another array and print that to sheet

Option Explicit
Sub Rearrange()
 Dim lastRow As Long
 lastRow = Library.Cells(Rows.Count, 1).End(xlUp).Row
 Dim firstColumn As Variant
 firstColumn = Library.Range("A1:A" & lastRow)
 Dim secondColumn As Variant
 secondColumn = Library.Range("B1:B" & lastRow)
 Dim totalCount As Long
 totalCount = Application.CountA(firstColumn) + Application.CountA(secondColumn)
 Dim combinedArray As Variant
 ReDim combinedArray(1 To totalCount)
 Dim i As Long
 Dim index As Long
 index = 1
 For i = 1 To lastRow
 combinedArray(index) = firstColumn(i, 1)
 index = index + 1
 If Not IsEmpty(secondColumn(i, 1)) Then
 combinedArray(index) = secondColumn(i, 1)
 index = index + 1
 End If
 Next
 Library.Range("A1:A" & totalCount) = Application.Transpose(combinedArray)
End Sub

Arrays are fast!

---

Also, as you can see worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("Library") and instead just use Library.

---

I also switched your

lastRow = Library.Range("A1").SpecialCells(xlCellTypeLastCell).row

To the standard.

---

I also used a For loop instead of Do While.

• user1996971: Jesus tonight! That worked perfectly. It seems that using arrays will be the solution to most of my VBA problems. For the actual 'reading into array step,' is this occurring during the 'For Loop'?
• Raystafarian: Reading from the two arrays to the combined array occurs in the loop. The first and second columns are read into arrays all at once because they are Variants and can take a Range
• Raystafarian: I was tempted to name this procedure something related to shuffling cards, because it really seems like a ripple shuffle would be a good analogy for what it accomplishes.