Improve performance of VBA code about splitting strings - excel

Question

I need to do the following:
I have a table where the 13th column contains strings such as
acbd,ef,xyz
qwe,rtyu,tqyuiop
And what I want to create new rows in order to separate those values:
acbd
ef
xyz
qwe
rtyu
tqyuiop
Meaning I would have now 6 rows instead of 2, and all the other information on cells would remain the same (i.e. all the other values of the row would repeat themselves through all the new rows).
What I have tried is the following:
Sub test()
Dim coma As Integer
Dim finalString As String
Set sh = ActiveSheet
For Each rw In sh.Rows
* If find a coma, then copy the row, insert a new row, and paste in this new row*
If InStr(1, sh.Cells(rw.Row, 13).Value, ",") Then
Rows(rw.Row).Copy
Rows(rw.Row).insert shift:=xlShiftDown
Rows(rw.Row).PasteSpecial xlPasteValues
* Now it will look for the position of the comma and assign
to finalString what's before the comma, and assign to mod String
what's after the comma *
coma = InStr(1, sh.Cells(rw.Row, 13).Value, ",")
finalString = Left(sh.Cells(rw.Row, 13).Value, coma - 1)
modString = Right(sh.Cells(rw.Row, 13).Value, Len(sh.Cells(rw.Row, 13).Value) - coma)
* Replace the values: *
sh.Cells(rw.Row, 13).Value = modString
sh.Cells(rw.Row - 1, 13).Value = finalString
End If
Next rw
MsgBox ("End")
End Sub
This code works perfectly well except that for tables with 400 rows it takes 15 +-5 seconds to be completed.
I would like some suggestions on how to improve the performance of this. Thank you!

Answer 1

With data in column L, give this a try:
Sub LongList()
Dim wf As WorksheetFunction, arr, s As String
Set wf = Application.WorksheetFunction
s = wf.TextJoin(",", True, Range("L:L"))
arr = Split(s, ",")
Range("M1").Resize(UBound(arr) + 1, 1).Value = wf.Transpose(arr)
End Sub
Note:
No looping over cells.No looping within cells. This process can be accomplished with just worksheet formulas, VBA is not needed.

Answer 2

Try this.
Sub test()
Dim vDB, vR(), vS, s
Dim i As Long, j As Integer, n As Long
vDB = Range("a1").CurrentRegion
For i = 1 To UBound(vDB, 1)
vS = Split(vDB(i, 13), ",")
For Each s In vS
n = n + 1
ReDim Preserve vR(1 To 13, 1 To n)
For j = 1 To 12
vR(j, n) = vDB(i, j)
Next j
vR(13, n) = s
Next s
Next i
Range("a1").Resize(n, 13) = WorksheetFunction.Transpose(vR)
End Sub
Before.
After.
If you have more columns, do like this.
Sub test()
Dim vDB, vR(), vS, s
Dim i As Long, j As Integer, n As Long
Dim c As Integer
vDB = Range("a1").CurrentRegion
c = UBound(vDB, 2)
For i = 1 To UBound(vDB, 1)
vS = Split(vDB(i, 13), ",")
For Each s In vS
n = n + 1
ReDim Preserve vR(1 To c, 1 To n)
For j = 1 To c
vR(j, n) = vDB(i, j)
Next j
vR(13, n) = s
Next s
Next i
Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)
End Sub

Answer 3

If you want an immediate boost in performance without having to adjust any kind of code just add Application events at the beginning...
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With
and be sure to turn them back on at the end of the code...
With Application
.DisplayAlerts = True
.ScreenUpdating = True
End With
These two simple statements usually speed up code considerably.

Answer 4

This should look for comma-delimited values in column M and overwrite the values in column M with the split values (basically what your code was doing).
Option Explicit
Sub splitValues()
Dim sourceSheet As Worksheet
Set sourceSheet = ActiveSheet
With sourceSheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "M").End(xlUp).Row
Dim inputValues() As Variant
inputValues = .Range("M1:M" & lastRow).Value2
Dim splitString() As String
Dim rowIndex As Long
Dim outputArray As Variant
Dim outputRowIndex As Long
outputRowIndex = 1
For rowIndex = LBound(inputValues, 1) To UBound(inputValues, 1)
splitString = VBA.Strings.Split(inputValues(rowIndex, 1), ",", -1, vbBinaryCompare)
outputArray = Application.Transpose(splitString)
.Cells(outputRowIndex, "M").Resize(UBound(outputArray, 1), UBound(outputArray, 2)).Value2 = outputArray
outputRowIndex = outputRowIndex + UBound(outputArray, 1)
Next rowIndex
End With
End Sub