Duplicate a row several times, append info, then repeat

A

artizhay

New Member
Joined
Jul 22, 2010
Messages
8
I don't know how complicated or simple this is, but I urgently need a macro that does the following for 372 rows.

Copy one row, duplicate it (either into a new sheet or on the current sheet) so that there are now 4 instances of the row, then append different bits of text to the cell in the first column of each of these four rows (append "-43", "-6", "-8", and "-10" respectively).

Here is general example of what I have:

<table style="border-collapse: collapse; width: 288pt;" width="384" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" width="64" span="6"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 48pt;" width="64" height="20">one</td> <td style="width: 48pt;" width="64">hi</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">two</td> <td>dude</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">three</td> <td>lol</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> </tr> </tbody></table>
And this would be the end result:

<table style="border-collapse: collapse; width: 288pt;" width="384" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" width="64" span="6"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 48pt;" width="64" height="20">one-43</td> <td style="width: 48pt;" width="64">hi</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> <td style="width: 48pt;" width="64" align="right">9</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">one-6</td> <td>hi</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">one-8</td> <td>hi</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">one-10</td> <td>hi</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> <td align="right">9</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">two-43</td> <td>dude</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">two-6</td> <td>dude</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">two-8</td> <td>dude</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">two-10</td> <td>dude</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> <td align="right">5</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">three-43</td> <td>lol</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">three-6</td> <td>lol</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">three-8</td> <td>lol</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> </tr> <tr style="height: 15pt;" height="20"> <td style="height: 15pt;" height="20">three-10</td> <td>lol</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> <td align="right">4</td> </tr> </tbody></table>

Obviously, doing this manually to 372 rows would be very time consuming and I really need to have this done soon.

Thank you very very much to whoever can help!
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
I found a code to do the four time duplication...but how can I append those pieces of texts to the A column as I described?

Here is the code. All data starts on A2 for code.

Code: 
[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
 
[COLOR=darkblue]Sub[/COLOR] exa()
Dim _
wksSource           [COLOR=darkblue]As[/COLOR] Worksheet, _
wksDest             [COLOR=darkblue]As[/COLOR] Worksheet, _
rngLastColOrRow     [COLOR=darkblue]As[/COLOR] Range, _
rngSourceColA       [COLOR=darkblue]As[/COLOR] Range, _
rngDestCell         [COLOR=darkblue]As[/COLOR] Range, _
rngSourceCell       [COLOR=darkblue]As[/COLOR] Range, _
rngLastColSource    [COLOR=darkblue]As[/COLOR] Range, _
lLColSource         [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
i                   [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], _
aryVals             [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR]
 
    [COLOR=green]'// Set a reference to both sheets                                                  //[/COLOR]
    [COLOR=darkblue]Set[/COLOR] wksSource = ThisWorkbook.Worksheets("Sheet1")
    [COLOR=darkblue]Set[/COLOR] wksDest = ThisWorkbook.Worksheets("Sheet2")
 
 
    [COLOR=darkblue]With[/COLOR] wksSource
        [COLOR=green]'// Attempt to find the last row with any data in the source sheet, from A2 to  //[/COLOR]
        [COLOR=green]'// the bottom/right-most cell.                                                 //[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rngLastColOrRow = RangeFound(Range(.Range("A2"), .Cells(Rows.Count, Columns.Count)))
        [COLOR=green]'// In case nothing found, bail...                                              //[/COLOR]
        [COLOR=darkblue]If[/COLOR] rngLastColOrRow [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            MsgBox "No vals in Source", 0, vbNullString
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]Sub[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
        [COLOR=green]'// else...[/COLOR]
        '// Set our range for the source, just using Col A                              //
        [COLOR=darkblue]Set[/COLOR] rngSourceColA = Range(.Range("A2"), .Cells(rngLastColOrRow.Row, 1))
 
        [COLOR=green]'// Find the last column with any data in it in source sheet, so our arrays     //[/COLOR]
        [COLOR=green]'// are not unnecessarily big.                                                  //[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rngLastColSource = RangeFound(Range(.Range("A2"), .Cells(Rows.Count, Columns.Count)), , , , , xlByColumns)
 
        lLColSource = rngLastColSource.Column
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
 
    [COLOR=green]'// Loop thru the first column in our source range...                               //[/COLOR]
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] rngSourceCell [COLOR=darkblue]In[/COLOR] rngSourceColA
 
        [COLOR=green]'// Assign the vals in the row to an array...                                   //[/COLOR]
        aryVals = rngSourceCell.Resize(, lLColSource).Value
 
        [COLOR=green]'// Assign (if first loop and Dest sheet is empty) our initial row or Find      //[/COLOR]
        [COLOR=green]'// the row last filled in Dest sheet...                                        //[/COLOR]
        [COLOR=darkblue]Set[/COLOR] rngLastColOrRow = RangeFound(Range(wksDest.Range("A2"), wksDest.Cells(Rows.Count, Columns.Count)))
        [COLOR=darkblue]If[/COLOR] rngLastColOrRow [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            [COLOR=darkblue]Set[/COLOR] rngDestCell = wksDest.Range("A1")
        [COLOR=darkblue]Else[/COLOR]
            [COLOR=darkblue]Set[/COLOR] rngDestCell = wksDest.Cells(rngLastColOrRow.Row, 1)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
        [COLOR=green]'//...then plunk the array in the next 4 rows.                                 //[/COLOR]
        [COLOR=darkblue]For[/COLOR] i = 1 [COLOR=darkblue]To[/COLOR] 4
            rngDestCell.Resize(, lLColSource).Offset(i).Value = aryVals
        [COLOR=darkblue]Next[/COLOR]
    [COLOR=green]'// Rinse and repeat...//[/COLOR]
    [COLOR=darkblue]Next[/COLOR]
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
 
[COLOR=darkblue]Function[/COLOR] RangeFound(SearchRange [COLOR=darkblue]As[/COLOR] Range, _
                    [COLOR=darkblue]Optional[/COLOR] FindWhat [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR] = "*", _
                    [COLOR=darkblue]Optional[/COLOR] StartingAfter [COLOR=darkblue]As[/COLOR] Range, _
                    [COLOR=darkblue]Optional[/COLOR] LookAtTextOrFormula [COLOR=darkblue]As[/COLOR] XlFindLookIn = xlValues, _
                    [COLOR=darkblue]Optional[/COLOR] LookAtWholeOrPart [COLOR=darkblue]As[/COLOR] XlLookAt = xlPart, _
                    [COLOR=darkblue]Optional[/COLOR] SearchRowCol [COLOR=darkblue]As[/COLOR] XlSearchOrder = xlByRows, _
                    [COLOR=darkblue]Optional[/COLOR] SearchUpDn [COLOR=darkblue]As[/COLOR] XlSearchDirection = xlPrevious, _
                    [COLOR=darkblue]Optional[/COLOR] bMatchCase [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Boolean[/COLOR] = [COLOR=darkblue]False[/COLOR]) [COLOR=darkblue]As[/COLOR] Range
 
    [COLOR=darkblue]If[/COLOR] StartingAfter [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
        [COLOR=darkblue]Set[/COLOR] StartingAfter = SearchRange(1)
    [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
 
    [COLOR=darkblue]Set[/COLOR] RangeFound = SearchRange.Find(What:=FindWhat, _
                                      After:=StartingAfter, _
                                      LookIn:=LookAtTextOrFormula, _
                                      LookAt:=LookAtWholeOrPart, _
                                      SearchOrder:=SearchRowCol, _
                                      SearchDirection:=SearchUpDn, _
                                      MatchCase:=bMatchCase)
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
 
Upvote 0
Try this in a copy of your workbook. Assumes data starts in column A and there is no heading row.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> artizhay()<br>    <SPAN style="color:#00007F">Dim</SPAN> lr <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, r <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    lr = Range("A" & Rows.Count).End(xlUp).Row<br>    <SPAN style="color:#00007F">For</SPAN> r = lr <SPAN style="color:#00007F">To</SPAN> 1 <SPAN style="color:#00007F">Step</SPAN> -1<br>        Rows(r).Copy<br>        Rows(r + 1).Resize(3).Insert<br>    <SPAN style="color:#00007F">Next</SPAN> r<br>    Columns("B").Insert<br>    <SPAN style="color:#00007F">With</SPAN> Range("B1:B" & lr * 4)<br>        .Formula = "=A1&Choose(Mod(Rows(B$1:B1)-1,4)+1,-43,-6,-8,-10)"<br>        .Value = .Value<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Columns("A").Delete<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0
Peter_SSs said:
Try this in a copy of your workbook. Assumes data starts in column A and there is no heading row.


Sub artizhay()
Dim lr As Long, r As Long

Application.ScreenUpdating = False
lr = Range("A" & Rows.Count).End(xlUp).Row
For r = lr To 1 Step -1
Rows(r).Copy
Rows(r + 1).Resize(3).Insert
Next r
Columns("B").Insert
With Range("B1:B" & lr * 4)
.Formula = "=A1&Choose(Mod(Rows(B$1:B1)-1,4)+1,-43,-6,-8,-10)"
.Value = .Value
End With
Columns("A").Delete
Application.ScreenUpdating = True
End Sub
Click to expand...
Yes! Works perfectly! Thank you so much for the quick response!
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Solved
Duplicates question and scoring system
Replies
6
Views
285
MountainFog
M
F
  • Question
Enhance simply subtract of date/times of time spent, to including indexing and subtracting time blocked from another table (with multiple criteria)
Replies
0
Views
248
freeb1893
F
E
  • Question
Adding a custom message.
Replies
1
Views
449
Micron
M
X
  • Question
Looking up a value on a table based on both column headings and rows
Replies
3
Views
259
Fluff
Fluff
K
  • Question
Excel Pivot table Time Values is not populating same as Source Sheet
Replies
1
Views
329
awoohaw
awoohaw

Forum statistics

Threads
1,215,615
Messages
6,125,857
Members
449,266
Latest member
davinroach

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top