HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Re-arranging a list into columns

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
arranginglistintocolumns

Problem

In short, what this script aims to do is take the following data:

1
Alpha
Beta
Delta
2
Beta
Echo
Foxtrot
Kilo
3 
Alpha
Kilo
4 
Beta
Echo
Kilo
Zulu


And re-arrange like this:

1       2        3      4
Alpha   Beta     Alpha  Beta
Beta    Echo     Kilo   Echo
Delta   Foxtrot         Kilo
        Kilo            Zulu


The code I have is as follows:

Private Sub PrepareLibrary()

Application.ScreenUpdating = False

Dim Rng As Range
Dim i As Long
Dim n As Range 
Dim x As Long
Dim Library As Worksheet
Dim LastRow As Long
Set Library = Sheets("Library")
i = 1
x = 0
LastRow = Library.Range("A1").SpecialCells(xlCellTypeLastCell).row

Do While i <= LastRow
Set Rng = Library.Range("A" & i)
Set n = Library.Range("A1")

If IsNumeric(Rng) = True Then  
x = x + 1 
Rng.Copy
n.Offset(0, x).Insert Shift:=xlDown 
i = i + 1
ElseIf IsNumeric(Rng) = False Then
Rng.Copy
n.Offset(1, x).Insert Shift:=xlDown
i = i + 1
ElseIf Application.WorksheetFunction.CountA(Rng) = 0 Then
i = i + 1

End If
Loop 
End Sub


Essentially, this runs through Column A one at time, copying each cell across individually, pasting into a new row whenever it comes across a number. It works well on small databases, but when expanding out to over 20,000 rows of data, I get a "not enough resources" message. Willing to attempt an entirely different approach if it seems possible. I'm new to VBA, so that may explain why this code is quite inefficient.

Solution

Your naming tells me nothing and doesn't follow Standard VBA naming conventions.

Dim i - this is a counter? why not rowNumber
Dim n - this is also a counter? why not labelNumber
Dim x - is this a counter? why not nextRowNumber
Dim Library should be library
Dim LastRow should be lastRow


With library in fact Worksheets have a CodeName property - View Properties window (F4) and the (Name) field can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

A good way to speed up your macro is to use Application.Screenupdating = False and Application.Calculation = xlManual and Application.EnableEvents = False. Just be sure to return them to True and xlAutomatic and True before exiting the sub.

Additionally, you're doing everything on the sheet, which is slow by nature. Even just reading into an array should be quicker -

Option Explicit

Private Sub PrepareLibrary()
    Application.Screenupdating = False
    Dim lastRow As Long
    Dim results As Variant
    Dim resultsIndex As Long
    Dim currentRow As Long
    Dim currentColumn As Long
    currentColumn = 0
    lastRow = Library.Cells(Rows.Count, "A").End(xlUp).Row
    ReDim results(1 To lastRow)
    results = Library.Range("A1:A" & lastRow).Value

    For resultsIndex = 1 To lastRow
        If IsNumeric(results(resultsIndex, 1)) Then
            currentColumn = currentColumn + 1
            Sheets("Sheet2").Cells(1, currentColumn) = results(resultsIndex, 1)
            currentRow = 2
        Else:
        Sheet2.Cells(currentRow, currentColumn) = results(resultsIndex, 1)
        currentRow = currentRow + 1
        End If
     Next
     Application.Screenupdating = True
End Sub


That's not a very good example of using the array to the maximum benefit, but it's something.

Code Snippets

Dim i - this is a counter? why not rowNumber
Dim n - this is also a counter? why not labelNumber
Dim x - is this a counter? why not nextRowNumber
Dim Library should be library
Dim LastRow should be lastRow
Option Explicit

Private Sub PrepareLibrary()
    Application.Screenupdating = False
    Dim lastRow As Long
    Dim results As Variant
    Dim resultsIndex As Long
    Dim currentRow As Long
    Dim currentColumn As Long
    currentColumn = 0
    lastRow = Library.Cells(Rows.Count, "A").End(xlUp).Row
    ReDim results(1 To lastRow)
    results = Library.Range("A1:A" & lastRow).Value

    For resultsIndex = 1 To lastRow
        If IsNumeric(results(resultsIndex, 1)) Then
            currentColumn = currentColumn + 1
            Sheets("Sheet2").Cells(1, currentColumn) = results(resultsIndex, 1)
            currentRow = 2
        Else:
        Sheet2.Cells(currentRow, currentColumn) = results(resultsIndex, 1)
        currentRow = currentRow + 1
        End If
     Next
     Application.Screenupdating = True
End Sub

Context

StackExchange Code Review Q#127575, answer score: 2

Revisions (0)

No revisions yet.