x
Solved

# Replicate data base on single cell

Posted on 2013-01-14
Medium Priority
240 Views
Hello All.

I have a dataset with eleven columns. The last column/cell contains data (eg. '1, 2, 3') that needs to be (1) separated and (2) used to replicate the previous data.

Columns 1-10 will need to be replicated with each new row based on the 'separated' last cell. So if the last cell has two+ variables then the variable will be separated and the other data replicated.

So you go from:
A         B
xxx      1, 2, 3

To:
A         B
xxx      1
xxx      2
xxx      3

See dataset attached.

Thanks,

Fernando
refusal-charges-test-data.xlsx
0
Question by:model_un
• 3
• 3
• 2
• +1

LVL 24

Expert Comment

ID: 38775227
Maybe try the attached..
refusal-charges-test-data.xlsm
0

LVL 26

Assisted Solution

redmondb earned 400 total points
ID: 38775288
Hi, model_un.

Please see attached (which does all entries including the last one). The code is...
``````Option Explicit

Sub Split_Comma()
Dim i As Long
Dim j As Long
Dim k As Long
Dim xLast_Row As Long
Dim xCell As Range
Dim xArray  As Variant
Dim xOld As Worksheet
Dim xNew As Worksheet

Set xOld = ThisWorkbook.Sheets("Sheet1")

xLast_Row = xOld.[A1].SpecialCells(xlLastCell).Row
If xLast_Row < 2 Then
MsgBox ("No data found - run cancelled.")
Exit Sub
End If

Application.ScreenUpdating = False

For i = 1 To xLast_Row
xArray = Split(xOld.Cells(i, 11), ",")
If UBound(xArray) > -1 Then
For j = 0 To UBound(xArray)
k = k + 1
xOld.Rows(i).Copy Destination:=xNew.Range("A" & k)
xNew.Cells(k, 11) = xArray(j)
Next
Else
k = k + 1
xOld.Rows(i).Copy Destination:=xNew.Range("A" & k)
End If
Next

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub
``````
Regards,
Brian.
refusal-charges-test-data-V2.xlsm
0

Author Comment

ID: 38775318
Thanks The_Barman.

Question... when I ran your macro again using the test data... I notice that it is not returning the last line (the only one with a single entry).

0

LVL 26

Expert Comment

ID: 38775329
model_un, it works in my one!
0

LVL 31

Accepted Solution

gowflow earned 1200 total points
ID: 38775342
try this. Make sure macroes are enabled and run the button in Sheet1 and it will create a brand new sheet with date labled.
gowflow.
refusal-charges-test-data.xlsm
0

LVL 24

Expert Comment

ID: 38775391
the last line is my bad needed to add one to output...

``````Sub Run_Macro()

Dim Arr, Arr2
Dim ArrOut()

Z = 0
Arr = Sheets("Sheet1").UsedRange.Value
For x = 2 To UBound(Arr)
Arr2 = Split(Arr(x, 11), ",")
For y = 0 To UBound(Arr2)
Z = Z + 1
ReDim Preserve ArrOut(1 To 11, 1 To Z)
For i = 1 To 10
ArrOut(i, Z) = Arr(x, i)
Next i
ArrOut(11, Z) = Arr2(y)
Next y
Next x

Sheets("sheet2").Range("A2:K" & UBound(ArrOut, 2) + 1).Value = Application.Transpose(ArrOut)

End Sub
``````

Brian, over large data sets you will find that the cell level changes slow the whole code down considerably... I just made the schoolboy error of my output range being one row too small. (doh!)
refusal-charges-test-data.xlsm
0

LVL 26

Expert Comment

ID: 38775498
The_Barman,

Thanks, I'm very aware of... both of those points!

Unless a macro has a significant time-impact on the user, I tend to lean to the side of simplicity over speed. I'm very reluctant to give a user a solution which is beyond their capability to support.

Regards,
Brian.
0

LVL 24

Assisted Solution

Steve earned 400 total points
ID: 38775534
And I have seen that there is a date error in the code.. good old VBA dates... attached is code which corrects the issue...

``````Sub Run_Macro()

Dim Arr, Arr2
Dim ArrOut()

Z = 0
Arr = Sheets("Sheet1").UsedRange.Value
For x = 2 To UBound(Arr)
Arr2 = Split(Arr(x, 11), ",")
For y = 0 To UBound(Arr2)
Z = Z + 1
ReDim Preserve ArrOut(1 To 11, 1 To Z)
For i = 1 To 9
ArrOut(i, Z) = Arr(x, i)
Next i
ArrOut(10, Z) = Format(Arr(x, 10), "dd-mmm-yyyy")
ArrOut(11, Z) = Arr2(y)
Next y
Next x

Sheets("sheet2").Range("A2:K" & UBound(ArrOut, 2) + 1).Value = Application.Transpose(ArrOut)

End Sub
``````
refusal-charges-test-data.xlsm
0

Author Closing Comment

ID: 38776275
Thank you all.

In the end GowFlow's solution worked without freezing my system.

Thanks!
0

## Featured Post

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.