Text to n rows + copy row and insert n times [Solved/Closed]

Report
-
 Duffy -
Hello,

I would appreciate your help with a macro I am trying to create in Excel 2007. My data is as follows:

Column1 Column2 Column3 Column4
Data1 Data1 Name1;Name2;Name3 Data1
Data2 Data2 Name1;Name2;Data2
Data3 Data3 Name1;Name2;Name3 Data3

Each cell in column 3 contains n number of names separated with a semicolon.

I need a macro that does these things:

1) Create n number of rows after the first row. N is the number of names in the cell in the first of column 3.

2) Separate the names in the rows below. (Similar to Text to Columns)

3) Copy the content of the other cells in the original row to the inserted rows below.

4) Proceed to the next row and do it all again.

The outcome should look like this:

Column1 Column2 Column3 Column4
Data1 Data1 Name1 Data1
Data1 Data1 Name2 Data1
Data1 Data1 Name3 Data1

Data2 Data2 Name1 Data2
Data2 Data2 Name2 Data2

Data3 Data3 Name1 Data3
Data3 Data3 Name2 Data3
Data3 Data3 Name3 Data3

Can you help me out?


34 replies

Hi,

I opened the duffy5 EXTRACT SHT 1 AND 2W.xlsm file.

I did the following steps:

1) I ran the macro "undo"

2) I ran the macro "testwo"

You can find the results from the file below:

http://speedy.sh/QQ385/duffy5-EXTRACT-SHT-1-AND-2W-Feedback.xlsm


The results are exactly the same I described to you earlier. The column L in sheet 2 is empty.

Best,

Duffy
2
Thank you

A few words of thanks would be greatly appreciated. Add comment

CCM 2942 users have said thank you to us this month

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
those semicolons confuse the issue
any how macro is ready
download the file "duffy.xlsm" from this webpage

http://speedy.sh/ruRSQ/duffy.xlsm


the main data is in sheet 1 (without semicolons)

result is in sheet2
you can retest by running only the macro "test"

the macros are repeated here

Sub test()
    Dim rrow1 As Range, rrow2 As Range, crow2 As String, rcol As Range
    Dim j As Long, k As Long, nname() As String
    Dim m As Integer, dest As Range, ddata() As String, n As Long
    Application.ScreenUpdating = False
    undo
    With Worksheets("sheet1")
        j = .Range("a1").End(xlDown).Row
        ReDim ddata(1 To j - 1)
        For k = 2 To j
            ddata(k - 1) = .Cells(k, Columns.Count).End(xlToLeft).Value
            'msgbox ddata(k - 1)
            Set rcol = Range(.Cells(k, "C"), .Cells(k, "c").End(xlToRight).Offset(0, -1))
            'msgbox rcol.Address
            m = WorksheetFunction.CountA(rcol)
            'msgbox m
            ReDim nname(1 To m)
            For n = 1 To m
                nname(n) = rcol(1, n)
                'msgbox nname(n)
            Next n
            'msgbox rcol.Address
            Range(.Cells(k, "A"), .Cells(k, "B")).Copy
            With Worksheets("sheet2")
                Set dest = .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                'msgbox dest.Address
                Range(dest, dest.Offset(m - 1, 0)).PasteSpecial
                For n = 1 To m
                    dest.Offset(n - 1, 0).Offset(0, 2) = nname(n)
                    .Cells(dest.Offset(n - 1, 0).Row, Columns.Count).End(xlToLeft).Offset(0, 1) = ddata(k - 1)
                Next n
            End With
        Next k
    End With
    Application.ScreenUpdating = True
    Application.CutCopyMode = False
    MsgBox "macro over"
End Sub



Sub undo()
    Worksheets("sheet2").Cells.Clear
End Sub
Hi,

Thank you so much for the quick reply.

Here is sample data in excel form:

http://speedy.sh/tvJBn/sample-data.xlsm

Is it possible to do it with the semicolons? How did you remove the semicolons in the data you sent? I do not really understand how the macro "counts" the amount of rows to be added.

Thank you for your help,

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
It is not clear whether the semicolons are coming in the beginning of name1,name 2 etc. in some cases no semicolon

see your firsts set
Data1 Data1 Name1;Name2;Name3 Data1

semicolons is there at the end of name1 and name2 and no semicolon at the end of name3. are these semicolons have any significance or are thy mere delimiters to separate the words.

i copied data as given by you in excel sheet and converted text to columns and then replace ;(semicolons by blanks) and thus removed semicolons.

did you modify the macro and tried it on your data.
olr do you want me to modify?????????????
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
it would be better if you can give about 5/6 rows of result

beside what is the sheet 4.
Sorry for being unclear.

Semicolons are used to separate words, they do not have any significance.

If I convert text to columns in column 3, it replaces the contents of the destination cells in column 4. How do you deal with this?

Duffy
Hi,

Here is the actual data I have:

http://speedy.sh/sChqY/Default-data.xlsm

The correct Column is "N" / Cleaned. How do you modify the macro so that it works with this data? I don't understand how the macro counts the actual number of rows to be added. If I use text to columns it replaces data on the columns to the right.

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
the macro is ready
sheet 2 you see is after running the macro
the macros are in vb editor(moduyle)

if you want to retest run the macro only "testone"

download the filel "duffy2.xlsm" from here

http://speedy.sh/YGf7R/duffy2.xlsm

the macros are given here for reference to others

check the result.post feedback

Sub testone()
Dim m As Long, j As Long, k As Long, semicolon() As Long, ccount As Long
Dim n As Long, nname() As String
Dim r As Range, start As Long
Dim dest As Range
Dim r1 As Range
Application.ScreenUpdating = False
start = 1
ccount = 1
undo
With Worksheets("sheet1")
j = .Range("a2").End(xlDown).Row
For k = 3 To j
Set r = .Cells(k, "L")
With r
m = Len(r.Value) - Len(WorksheetFunction.Substitute(r, ";", ""))
'msgbox m
If m = 0 Then
nname(1) = r.Value
GoTo m_is_zero
End If
End With
ReDim semicolon(1 To m)
ReDim nname(1 To m + 1)
For n = 1 To m + 1
If n = m + 1 Then
nname(n) = Mid(r, start, Len(r) - semicolon(n - 1))
'msgbox nname(n)
GoTo nextstep
End If
semicolon(n) = InStr(ccount, r, ";")
'msgbox semicolon(n)
nname(n) = Mid(r, start, semicolon(n) - 1)
'msgbox nname(n)
''msgbox nname(n)
start = start + semicolon(n)
'msgbox start
'ccount = ccount + semicolon(n)
Next n
nextstep:
m_is_zero:
.Range(.Cells(k, 1), .Cells(k, "K")).Copy
With Worksheets("sheet2")
Set dest = .Cells(Rows.count, "A").End(xlUp).Offset(1, 0)
Range(dest, dest.Offset(m, 0)).PasteSpecial
For n = 1 To m + 1
dest.Offset(n - 1, 0).End(xlToRight).Offset(0, 1) = nname(n)
Next n
End With
Set r1 = Range(.Cells(k, "M"), .Cells(k, "M").End(xlToRight))
r1.Copy
With Worksheets("sheet2")
Set dest = .Cells(Rows.count, "M").End(xlUp).Offset(1, 0)
Range(dest, dest.Offset(m, 0)).PasteSpecial
End With
start = 1
ccount = 1
Next k
End With
With Worksheets("sheet2")
Range(.Range("a2"), .Range("A2").End(xlDown)).EntireRow.AutoFit

Range(.Range("A2"), .Range("a2").End(xlToRight)).EntireColumn.AutoFit
End With
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "macro over"
End Sub



Sub undo()
With Worksheets("sheet2")
.Cells.Clear
End With
End Sub
Hi,

Thank you so much again!

It seems that the code does not allow spaces between the "Names". If you check the sheet 2 from this file:

http://speedy.sh/UdvVE/duffy3.xlsm

Could you help me out with that one?

Otherwise it is perfect!

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
"does not allow spaces between the "Names"
do not understand this.
give an example from sheet and sheet 2
in sheet 1 there is no name (column L is blank and so blank in result also
what exactly do you want in such a case.

I can think of some bug. shall look into it.
If this is in sheet 1:

Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc
Name 1;Name 2 plc;Name 3 plc


Then the output is this:

Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc
Name 1
Name 2
plc;Name 3 plc

For some reason the semicolon drops the latter part of the name to a new row.

Any ideas?

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
I am sednikng the file l"duffy3.xlsm to speedyshare.com. the macro is now called "testtwo"
to avoid confusion '

now rerun testtwo and see sheet2

download the file from

http://speedy.sh/wfyD7/duffy3.xlsm

sheet 2 is AFTER running macro
for retest run"testtwo" again.
your comments please
Hi,

Thank you so much for your help.

Blank cells seem to causes mistakes in the output sheet.

You can check it from here:

http://speedy.sh/tv5Kn/duffy4.xlsm

Can you help me out with this?

Best,

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
HELP ME TO HELP YOU

be specific and clear.

"Blank cells seem to causes mistakes"

what cells which cells. give the cell addresses. in which sheet.
if details are there it would be easier to correct the macro

anyhow I shall look into it.
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
ok the macro testwo is slightly modified. the new file name is
duffy5.xlsm Download this file from


http://speedy.sh/Z8Xdq/duffy5.xlsm


check for any other bug????
Hello,

Thank you for the update. I was only now able to test the macro.

However I found some bugs:

1) When you run the macro "testwo" it mixed the original names. The original names in sheet 1 do not stay in their original positions.

2) Also, in sheet 2 it displays no names. So the whole column L is left blanc in sheet 2.

Do you find the same problem?
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
your doubts not clear

let us go step by step

suppose you sheet1 is the one which is in duffy5

then on this basis IS SHEET 2 OK????

now did you try test two on some other shee1 .; in that case what is that sheet1

let us see sheet 1
let us identity the country in column K as the pivot (not the pivot of the pivot table)
in row 3 of sheet1 the country is Germany.
there are four names in column L of this row
in sheet 2 ink four ROWS (rows 2 to 5) the other common items are copied only change was the four names.

in the case of row 4 in sheet 1(Greece) there is no name
so row no;. 6 in sheet 2 contains all the common items but NO NAME

IS THIS NOT OK??????????????????????

so explain little more so that macro can be modified.

first test the macro with the existing file duffy5 and then go to your original file.
if the macro does not work then inspect configuration of shee1 of duffy 5 and sheet 1 of original (operative) file .
Hello,

Looking at Sheet 1 in Duffy5:

There are now these names:

Citigroup Inc;DnB NOR Bank ASA;SG Corporate & Investment Banking;Sumitomo Mitsui Banking Corp

Dresdner Kleinwort
Citigroup Inc;DnB NOR Bank ASA;SG Corporate & Investment Banking;Sumitomo Mitsui Banking Corp
Calyon;Royal Bank of Scotland plc
Dresdner Kleinwort;Mizuho Corporate Bank Ltd;Commerzbank AG
Dresdner Kleinwort
Citigroup Inc;DnB NOR Bank ASA;SG Corporate & Investment Banking;Sumitomo Mitsui Banking Corp
Citigroup Inc;DnB NOR Bank ASA;SG Corporate & Investment Banking;Sumitomo Mitsui Banking Corp

When I run the macro, these names change in the Sheet 1:

DnB NOR Bank ASA
SG Corporate & Investment Banking
Sumitomo Mitsui Banking Corp
SG Corporate & Investment Banking
Sumitomo Mitsui Banking Corp
SG Corporate & Investment Banking
Sumitomo Mitsui Banking Corp
SG Corporate & Investment Banking
Sumitomo Mitsui Banking Corp
SG Corporate & Investment Banking
Sumitomo Mitsui Banking Corp

Do you see to problem now?

Best,

Duffy
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
791
QUICKLY CHECK ONE ITEM AND LET ME KNOW

the result is in sheet 2 and not in sheet1
is sheet 2 ok
check and reply back so that if necessary I modify themcro
Sheet 2 is not ok. When I run the macro, it leaves the Column L in Sheet 2 blank. So the macro mixes up the names in sheet 1 and there are no names in sheet 2 when I run the macro.

Duffy