I have previously asked the following question, and the code is the accepted answer. It works correctly but is there a faster away, or more efficent solution, either in code or tweaking my Excel settings. The code is running in Excel 2007.

The question:

I am looking to achive the following:

Within column W of a report, which is pull from a sharepoint site, it is possible to have mulitple entry's in the single cell, for example:

Apple;#1;#Orange;#2,#Nut;#14

What I would like is a piece of code which identifies the multiple entry, and creates a single row for each entry within the cell, so from the above example I would have three rows, with only one entry within the column W. The details held within the rest of the row apply to each entry, so a straight copy of the row would work.

The multiple entrys could be upto a maximum of 21 items.

Many thanks

The code:

Sub splitme()Application.ScreenUpdating = FalseDim ws As WorksheetSet ws = ActiveSheetDim r As RangeDim V As VariantDim a() As StringDim i As IntegerDim row As LongDim endRow As LongSet r = Intersect(ws.UsedRange, ws.Range("W:W"))row = r.rowendRow = r.row - 1 + r.Rows.CountWhile row <= endRowSet r = ws.Range("W" & row)a = Split(r.Value, ";")If UBound(a) > 2 Thenr.Value = a(0) & ";" & a(1)For i = 2 To UBound(a) Step 2V = r.EntireRowr.EntireRow.Insertr.EntireRow.Offset(-1) = V'Set r = r.Offset(1)If UBound(a) >= i + 1 Then r.Value = a(i) & ";" & a(i + 1)Else r.Value = a(i)End IfNext iEnd Ifrow = r.row + 1WendApplication.ScreenUpdating = TrueEnd Sub

Ah I see, you have a lot of data and it takes to long to run?

Well a way to speed up, and again it is limited by the amount of data you are having, is to handle everything in variables (Dataranges) and when everything is calculated just overwriting the entire sheet, that will be much faster then inserting rows..

With 10705 rows of data, Excel is freezing, and when it does successfully complete its taking over 3hrs! I am asking if there is a more effective way of achieving my requirement?

Regards

0

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

with this code you load your data into a array Dim shtrng(20000, 60) As Variant
Dim lastrow, i, j As Integer
ActiveSheet.UsedRange.Rows.Count
For i = 1 To lastrow
For j = 1 To 60
shtrng(i, j) = Cells(i, j)
Next j
next i

then you can run over the sheet again and paste the row whilst dissasembling columns W like shown above.
If you need me to re write the code I can do but only tomorrow. today I won't have anymore time to help...

Dim shtrng(20000, 60) As Variant
Dim lastrow, i, j As Integer
lastrow = ActiveSheet.UsedRange.Rows.Count
For i = 1 To lastrow
For j = 1 To 60
shtrng(i, j) = Cells(i, j)
Next j
Next i

Thank you for your help, I am sorry but I do not fully understand how to use the above code, so if you could come back to me tomorrow. Have a good night.

Sub kTest() Dim x, k(), ka, i As Long, n As Long, j As Long, c As Long Const TotalCols As Long = 60 Const SplitCol As Long = 23 'W ka = ActiveSheet.UsedRange.Resize(, TotalCols) ReDim k(1 To UBound(ka, 1) * 15, 1 To TotalCols) For i = 1 To UBound(ka, 1) x = Split(ka(i, SplitCol), ";") For j = 0 To UBound(x) Step 2 n = n + 1 For c = 1 To UBound(ka, 2) If UBound(x) >= j + 1 Then If c = SplitCol Then k(n, c) = x(j) & ";" & x(j + 1) Else k(n, c) = ka(i, c) End If Else If c <> SplitCol Then k(n, c) = ka(i, c) Else k(n, c) = x(j) End If End If Next Next Next Range("a1").Resize(n, TotalCols).Value = kEnd Sub

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.

The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calculâ€¦