# If cell contains "specific text", then cut that specific cell and the next 9 cells to new row

#### mac888

##### New Member
Hi Everyone,

I am new to writing macros.
I am trying to figure out a macro to cut a specific cell and the next 9 cells to a new row.
Tried the macro recorder but don't know how to get it to continue to the end of the row until there is no more data.

The scenario is a sheet with 1 row that contains hundreds of columns with data.
In that row, there is a "common text" in a cell and then 9 more cells of data, and this pattern reoccurs.

The worksheet before:

 A B C D E F G H I J K L M N 1 text data1 data2 data3 data4 data5 data6 data7 data8 data9 text data10 data11 data12

<tbody>
</tbody>

In a new Worksheet after macro:

 A B C D E F G H I J 1 text data1 data2 data3 data4 data5 data6 data7 data8 data9 2 text data10 data11 data12 data13 data14 data15 data16 data17 data18 3 text data19 data20 data21 data22 data23 data24 data25 data26 data27

<tbody>
</tbody>

Any help would be appreciated!
Thanks,
Stan

### Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!

#### sericom

##### Well-known Member
Code:
``````r = 1: c = 1
For i = 1 To Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
Worksheets("Sheet2").Cells(r, c) = Worksheets("Sheet1").Cells(1, i)
c = c + 1
If c = 11 Then
r = r + 1
c = 1
End If
Next``````

Rename Sheet1 and Sheet2 if needed.

#### hiker95

##### Well-known Member
mac888,

Here is another macro for you to consider that will adjust for the varying number of columns in row 1 in the raw data worksheet.

You can change the raw data worksheet name in the macro.

After the macro (using two arrays in memory) in a new worksheet Results:

<b>Excel 2007</b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #A6AAB6"><colgroup><col width="25px" style="background-color: #E0E0F0" /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /><col /></colgroup><thead><tr style=" background-color: #E0E0F0;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th><th>D</th><th>E</th><th>F</th><th>G</th><th>H</th><th>I</th><th>J</th><th>K</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="font-weight: bold;;">text</td><td style=";">data1</td><td style=";">data2</td><td style=";">data3</td><td style=";">data4</td><td style=";">data5</td><td style=";">data6</td><td style=";">data7</td><td style=";">data8</td><td style=";">data9</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="font-weight: bold;;">text</td><td style=";">data10</td><td style=";">data11</td><td style=";">data12</td><td style=";">data13</td><td style=";">data14</td><td style=";">data15</td><td style=";">data16</td><td style=";">data17</td><td style=";">data18</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style="font-weight: bold;;">text</td><td style=";">data19</td><td style=";">data20</td><td style=";">data21</td><td style=";">data22</td><td style=";">data23</td><td style=";">data24</td><td style=";">data25</td><td style=";">data26</td><td style=";">data27</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:4.2em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #A6AAB6;border-top:none;text-align: center;background-color: #E0E0F0;color: #161120">Results</p><br /><br />

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
``````Sub ReorgData()
' hiker95, 03/17/2015, ME842984
Dim w1 As Worksheet, wr As Worksheet
Dim a As Variant, o As Variant
Dim i As Long, j As Long
Dim lc As Long, nlc As Long, n As Long, c As Long
Set w1 = Sheets("Sheet1")     '<-- change the raw data worksheet name here
With w1
lc = .Cells(1, Columns.Count).End(xlToLeft).Column
n = 10
nlc = Application.Ceiling(lc, n)
a = .Range(.Cells(1, 1), .Cells(1, nlc))
ReDim o(1 To UBound(a, 2) / n, 1 To 10)
End With
For c = 1 To UBound(a, 2) Step 10
j = j + 1
o(j, 1) = a(1, c): o(j, 2) = a(1, c + 1)
o(j, 3) = a(1, c + 2): o(j, 4) = a(1, c + 3)
o(j, 5) = a(1, c + 4): o(j, 6) = a(1, c + 5)
o(j, 7) = a(1, c + 6): o(j, 8) = a(1, c + 7)
o(j, 9) = a(1, c + 8): o(j, 10) = a(1, c + 9)
Next c
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
With wr
.UsedRange.Clear
.Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
.Cells(1, 1).Resize(UBound(o, 1)).Font.Bold = True
.Columns(1).Resize(, 10).AutoFit
.Activate
End With
End Sub``````

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

Replies
0
Views
351
Replies
0
Views
128
Replies
11
Views
204
Replies
5
Views
289
Replies
2
Views
214

1,129,879
Messages
5,638,800
Members
417,053
Latest member
SaturdayNight

### 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.

### Which adblocker are you using?

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

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