# Sorting worksheet by a given column

My code runs exactly as it should. However, I would like to make it run a bit faster. I have tried defining some variables as Long to run it faster but it is still a bit slow.

Is it possible to remove some code to make the macro run faster?

Sub sortiereninl()

Dim sort As Worksheet
Set sort = Worksheets("Inland")

Dim count As Long
Dim n As Long
Dim wkn As Long
wkn = sort.Cells.Find("WKN").Column
Dim lastcolumn As Long
lastcolumn = sort.UsedRange.SpecialCells(xlCellTypeLastCell).Column
Dim lastrow As Long
lastrow = sort.UsedRange.SpecialCells(xlCellTypeLastCell).Row
Dim allrows As Long
allrows = WorksheetFunction.CountA(Range(Cells(2, wkn), Cells(lastrow, lastcolumn)))

For i = 2 To allrows + 1
If Cells(i, wkn).Value <> "" Then
count = sort.Cells(i, Columns.count).End(xlToLeft).Column - wkn
If count <> 0 Then
sort.Range(Cells(i + 1, wkn), Cells(i + count, wkn)).EntireRow.Insert
sort.Range(Cells(i, wkn + 1), Cells(i, count + wkn)).Copy
sort.Cells(i + 1, wkn).PasteSpecial Transpose:=True
End If

End If
Next i

With sort.Range(Cells(1, wkn + 1), Cells.SpecialCells(xlCellTypeLastCell))
.ClearContents
End With

End Sub

• What is the code solving? We can only help you optimize the code when we know what it is doing. Please read How do I ask a good question? Sep 27 '21 at 10:54
• Yes, it is possible. Changing the variable to long is not going to improve performance. Here are some tips to help: Top Ten Tips To Speed Up Your VBA Code Sep 27 '21 at 11:01
• I will say that a variable named sort will throw people off. I presume it means something in your language that's different from what it means in English, remember, though that Range.Sort is the same in VBA no matter what spoken language you use. I'm only on my 1st cup of coffee, but I saw all those lines beginning sort.Range(... and though you were sorting your data in a loop which would be slow... Sep 27 '21 at 11:35
• Your best bet would probably be to copy the data from the worksheet to Dim sourceData() as Variant, copy/transpose it to Dim destData() as Variant, then past destData() back to the worksheet. Reading/writing to the worksheet is going to be the slowest operation you're doing in that loop, though I'm not sure where PasteSpecial.Transpose falls in the "speed" range. There are plenty of answers here and at StackOverflow on how to copy a range from a worksheet to an array and back. Sep 27 '21 at 11:45
• Welcome to Code Review! I changed the title so that it describes what the code does per site goals: "State what your code does in your title, not your main concerns about it.". Feel free to edit and give it a different title if there is something more appropriate. Sep 27 '21 at 18:11

## 2 Answers

It is faster to read the data from the Sheet into an array, process the array values into a new array, then write the new array back to the sheet.

Sub sortierenin2()

Dim sort As Worksheet
Dim count As Long, i As Long, n As Long, newrows As Long
Dim WKN As Long, lastcolumn As Long, lastrow As Long
Dim arIn, arOut, iOut As Long, j As Long, t0 As Single: t0 = Timer

Set sort = Worksheets("Inland")
With sort
WKN = .Cells.Find("WKN").Column
lastcolumn = .UsedRange.SpecialCells(xlCellTypeLastCell).Column
lastrow = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
newrows = WorksheetFunction.CountA(.Range(.Cells(2, WKN + 1), .Cells(lastrow, lastcolumn)))
' Copy from sheet into array
arIn = .UsedRange
End With
' Size array to take existing rows and new rows
ReDim arOut(1 To UBound(arIn) + newrows, 1 To WKN)
For i = 1 To UBound(arIn)
iOut = iOut + 1
For j = 1 To lastcolumn
If j > WKN Then
' Insert a new row for every column after WKN
If (i > 1) And (arIn(i, j) <> "") Then
iOut = iOut + 1
arOut(iOut, WKN) = arIn(i, j)
End If
Else
' Copy existing row
arOut(iOut, j) = arIn(i, j)
End If
Next
Next

' Write array with inserted rows back to sheet.
Application.ScreenUpdating = False
With sort
.UsedRange.ClearContents
.Range("A1").Resize(UBound(arOut), UBound(arOut, 2)) = arOut
End With
Application.ScreenUpdating = True

MsgBox Format(Timer - t0, "0.00 secs")

End Sub

• You have presented an alternative solution, but haven't reviewed the code. Please explain your reasoning (how your solution works and why it is better than the original) so that the author and other readers can learn from your thought process.
– Malachi
Sep 27 '21 at 14:23
• We Appreciate the added bit about the reason for using Arrays, but could you add more explanation around the steps that you took to convert the OP Code to your Code with the Arrays? it would help the OP understand how to write better code.
– Malachi
Sep 27 '21 at 17:22
• @CDP1802 thanks a lot for this code! It works perfectly. Sep 29 '21 at 9:25

## Turn Off ScreenUpdating and Calculations to Optimize Performance

This stops VBA from having to want for Excel to recalculate formulas and refresh the screen.

Turn Off ScreenUpdating and Calculations:

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With


Restore ScreenUpdating and Calculations:

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With


## Option Explicit

Adding Option Explicit to the top of the Modules forces us to declarer our variables. This prevents use from testing code that has typos.

## Ranges Should be Fully Qualified

Ranges should be "fully qualified" to their Worksheet. This ensures that you code is processing the cells on the correct worksheet.

Set sort = Worksheets("Inland")
With sort.Range(Cells(1, wkn + 1), Cells.SpecialCells(xlCellTypeLastCell))
.ClearContents
End With


Sort is qualified to the Inland worksheet. Cells(1, wkn + 1) references the ActiveSheet. The code will throw an error if Inland is not the active worksheet.

The code below is fully qualified. It will run as expected as long as the Workbook is the active Workbook.

With Worksheets("Inland")
With sort.Range(.Cells(1, wkn + 1), .Cells.SpecialCells(xlCellTypeLastCell))
.ClearContents
End With
End With


When working with multiple workbooks, Ranges should be fully qualified to their workbook like this:

With ThisWorkbook.Worksheets("Inland")
With sort.Range(.Cells(1, wkn + 1), .Cells.SpecialCells(xlCellTypeLastCell))
.ClearContents
End With
End With


## Variable Naming

Variables should have clear unambiguous names. Ideally, our code should make sense when spoken.

## Use Range.CurrentRegion when Applicable

Here is my fallback order for setting up data in excel

1. Tables: the ideal way to reference data in Excel
2. Lists: a contiguous block of related cells. The block of code may have a header row but no completely empty rows and no extra rows that have nothing to do with you target data.

Setting your data up like this will make it easy to reference your ranges.

In the following examples we have a list that starts in the first cell on the Inland tab.

Example 1: Header and Data Rows

With Worksheets("Inland")
Set Target = .Range("A1").CurrentRegion
End With


Example 2: Only Header Row

With Worksheets("Inland")
Set Target = .Range("A1").CurrentRegion.Rows(1)
End With


Example 3: Only Header Row

With Worksheets("Inland")
Set target = .Range("A1").CurrentRegion
Set target = Intersect(target, target.Offset(1))
End With


## Refactored Code

The fun part of the review!

Notice that I clearly define all ranges that I will be working with. While writing the code I use Range.Select to ensure the correct range is getting targeted.

Sub RefactoredSortiereninl()

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = False
End With

With Worksheets("Inland")
Dim DataRange As Range
Set DataRange = .Range("A1").CurrentRegion

Dim DataBodyRange As Range
Set DataBodyRange = Intersect(DataRange, DataRange.Offset(1))

Dim WKNColumn As Range
Set WKNColumn = Intersect(DataRange, DataRange.Rows(1).Find("WKN").EntireColumn)

Dim DataColumns As Range
Rem The next line was originally posted but would return extra columns if WKNColumn was the last column
Rem Set DataColumns = WKNColumn.Resize(, WKNColumn.End(xlToRight).Column - WKNColumn.Column + 1)
Set DataColumns = WKNColumn.Resize(, .Columns(.Columns.count).End(xlToLeft).Column - WKNColumn.Column + 1)
Dim WKN As Long
WKN = WKNColumn.Column

Dim NewLastRow As Long
NewLastRow = WorksheetFunction.CountA(DataColumns) + 1

Dim r As Long, count As Long
For r = 2 To NewLastRow
If .Cells(r, WKN).Value <> "" Then
count = .Cells(r, .Columns.count).End(xlToLeft).Column - WKN
If count <> 0 Then
.Range(.Cells(r + 1, WKN), .Cells(r + count, WKN)).EntireRow.Insert
.Range(.Cells(r, WKN + 1), .Cells(r, count + WKN)).Copy
.Cells(r + 1, WKN).PasteSpecial Transpose:=True
End If
End If
Next r

Rem Rem The next line was originally posted but would fail if DataColumns last column was the last column in the Worksheet
Rem DataColumns.Offset(, 1).ClearContents
DataColumns.Resize(, DataColumns.Columns.count - 1).Offset(, 1).ClearContents

End With

With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

End Sub


## Optimal Performance

Performing all work in memory using arrays will give you the optimal performance. Here are the steps:

1. Read the data into an array
2. Declare a second array to hold the results
3. Size the results array to fit the new data
4. Assign the old values to the results array
5. Clear the old data
6. Write the new data to the worksheet

I find that this technique is able to process ~60,000 values per second.

• @CDP1802 Good catch! I removed Option Explicit when I was testing the OP's code. Sep 27 '21 at 14:09
• Thank you so much! This was such a detailed solution and you explained well. Really amazing work! Sep 28 '21 at 7:55
• I am just getting one error with the refactored code on the line - DataColumns.Offset(, 1).ClearContents . The error reads as Application-defined or object-defined error. Sep 28 '21 at 8:26
• @Kanishkgarg I modified the code to handle some edge cases. Let me know if it works for you. CDP1802 's is faster then mine. Sep 28 '21 at 16:50
• Hey, I am still getting the same error for the line - DataColumns.Resize(, DataColumns.Columns.count - 1).Offset(, 1).ClearContents. I think your comment about Datacolumns being the last column holds true. Sep 29 '21 at 8:50