Mixing
Improve performance of VBA code about splitting strings
2
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!
excel vba string excel-vba
asked Nov 19 '18 at 13:39
b720986
113
add a comment |
2
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!
excel vba string excel-vba
asked Nov 19 '18 at 13:39
b720986
113
2
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
1
And useSplitrather than repeated searching and parsing.
– Rory
Nov 19 '18 at 13:49
add a comment |
2
2
2
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!
excel vba string excel-vba
asked Nov 19 '18 at 13:39
b720986
113
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!
excel vba string excel-vba
excel vba string excel-vba
asked Nov 19 '18 at 13:39
b720986
113
asked Nov 19 '18 at 13:39
b720986
113
asked Nov 19 '18 at 13:39
b720986
113
asked Nov 19 '18 at 13:39
b720986
113
asked Nov 19 '18 at 13:39
b720986
113
113
2
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
1
And useSplitrather than repeated searching and parsing.
– Rory
Nov 19 '18 at 13:49
add a comment |
2
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
1
And useSplitrather than repeated searching and parsing.
– Rory
Nov 19 '18 at 13:49
2
2
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
1
1
And use
Split rather than repeated searching and parsing.– Rory
Nov 19 '18 at 13:49
And use
Split rather than repeated searching and parsing.– Rory
Nov 19 '18 at 13:49
add a comment |
4 Answers
4
active
oldest
votes
0
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
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
add a comment |
2
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.
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
add a comment |
1
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.
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
add a comment |
0
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
answered Nov 19 '18 at 14:41
chillin
1,239134
add a comment |
Your Answer
StackExchange.ifUsing("editor", function () {
StackExchange.using("externalEditor", function () {
StackExchange.using("snippets", function () {
StackExchange.snippets.init();
});
});
}, "code-snippets");
StackExchange.ready(function() {
var channelOptions = {
tags: "".split(" "),
id: "1"
};
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function() {
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled) {
StackExchange.using("snippets", function() {
createEditor();
});
}
else {
createEditor();
}
});
function createEditor() {
StackExchange.prepareEditor({
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: true,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: 10,
bindNavPrevention: true,
postfix: "",
imageUploader: {
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
},
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
});
}
});
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53375873%2fimprove-performance-of-vba-code-about-splitting-strings%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
4 Answers
4
active
oldest
votes
4 Answers
4
active
oldest
votes
active
oldest
votes
active
oldest
votes
0
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
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
add a comment |
0
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
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
add a comment |
0
0
0
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
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
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
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
edited Nov 20 '18 at 14:00
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
answered Nov 19 '18 at 23:10
Dy.Lee
3,403159
3,403159
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
add a comment |
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
Thanks! This worked perfectly. One more thing, what if I wanted to preserve also what is next to column 13? I mean, columns 14,15,16... (I have 19 columns)
– b720986
Nov 20 '18 at 11:12
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
@b720986, I added the code.
– Dy.Lee
Nov 20 '18 at 14:01
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
Thank you very much, that worked much more quickly than mine.
– b720986
Nov 21 '18 at 17:00
add a comment |
2
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.
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
add a comment |
2
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.
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
add a comment |
2
2
2
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.
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
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.
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
edited Nov 19 '18 at 14:48
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
answered Nov 19 '18 at 14:35
Gary's Student
72.3k93762
72.3k93762
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
add a comment |
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
I know that what you said is possible without VBA. What I mean is, columns A to K are also full of information and so, for example, take row 5, with data in columns A,..,K and in M "abc,ef,xyz". I want to create rows, one with the data from A to K and "abc" in M, another one with the data (repeated) from A to K and "ef" in column M, etc.
– b720986
Nov 19 '18 at 15:16
add a comment |
1
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.
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
add a comment |
1
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.
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
add a comment |
1
1
1
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.
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
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.
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
answered Nov 19 '18 at 14:07
rohrl77
1,68942749
1,68942749
add a comment |
add a comment |
0
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
answered Nov 19 '18 at 14:41
chillin
1,239134
add a comment |
0
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
answered Nov 19 '18 at 14:41
chillin
1,239134
add a comment |
0
0
0
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
answered Nov 19 '18 at 14:41
chillin
1,239134
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
answered Nov 19 '18 at 14:41
chillin
1,239134
answered Nov 19 '18 at 14:41
chillin
1,239134
answered Nov 19 '18 at 14:41
chillin
1,239134
answered Nov 19 '18 at 14:41
chillin
1,239134
1,239134
add a comment |
add a comment |
draft saved
draft discarded
Thanks for contributing an answer to Stack Overflow!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
Some of your past answers have not been well-received, and you're in danger of being blocked from answering.
Please pay close attention to the following guidance:
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function () {
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fstackoverflow.com%2fquestions%2f53375873%2fimprove-performance-of-vba-code-about-splitting-strings%23new-answer', 'question_page');
}
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function () {
StackExchange.helpers.onClickDraftSave('#login-link');
});
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
2
Read your Usedrange into an array, do the spltting and copying there, place result back to your sheet
– EvR
Nov 19 '18 at 13:46
1
And use
Splitrather than repeated searching and parsing.– Rory
Nov 19 '18 at 13:49