patternMinor
Rearrange data without using Cut and Insert
Viewed 0 times
withoutrearrangeinsertcutusinganddata
Problem
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.
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 SubSolution
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
Arrays are fast!
Also, as you can see worksheets have a
I also switched your
To the standard.
I also used a
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 SubArrays 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).rowTo the standard.
I also used a
For loop instead of Do While.Code Snippets
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 SublastRow = Library.Range("A1").SpecialCells(xlCellTypeLastCell).rowContext
StackExchange Code Review Q#128582, answer score: 4
Revisions (0)
No revisions yet.