Washcare
asked on
Change multiple values in a cell, to multiple duplicate rows
Good Afternoon
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:
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;#
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 = False
Dim ws As Worksheet
Set ws = ActiveSheet
Dim r As Range
Dim V As Variant
Dim a() As String
Dim i As Integer
Dim row As Long
Dim endRow As Long
Set r = Intersect(ws.UsedRange, ws.Range("W:W"))
row = r.row
endRow = r.row - 1 + r.Rows.Count
While row <= endRow
Set r = ws.Range("W" & row)
a = Split(r.Value, ";")
If UBound(a) > 2 Then
r.Value = a(0) & ";" & a(1)
For i = 2 To UBound(a) Step 2
V = r.EntireRow
r.EntireRow.Insert
r.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 If
Next i
End If
row = r.row + 1
Wend
Application.ScreenUpdating = True
End 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..
Kind regards
Eric
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..
Kind regards
Eric
ASKER
Eric
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
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
Well how many columns are you facing?
And after excel ahs finished how many rows do you have?
I need to now this to be able to see if you can do this with variable Arrays
Kind regards
Eric
And after excel ahs finished how many rows do you have?
I need to now this to be able to see if you can do this with variable Arrays
Kind regards
Eric
ASKER
Eric
There are 60 columns, and after the code has run I am left with about 15203 rows.
Regards
There are 60 columns, and after the code has run I am left with about 15203 rows.
Regards
Hi Washcare,
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...
Kr
Eric
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
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...
Kr
Eric
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Eric
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.
Regards
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.
Regards
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you both, works amazingly!
Your code does excactly what you are demanding?
What seems to be the problem?
Kr
Eric