Help with macro that will delete a set series of rows from column "A".

[IrishMist1748]

Hello!

I need a macro that will delete a repeating series of rows? What I am faced with is a set series of rows (see the series below) in column "A" that is repeated on occasion. What I need to happen is for all the rows in that series to be deleted each time it is found WITHOUT even one set of the series remaining in column "A".

Thank you!

Type

Weight

Sizes

Gallery

Shape

Weight

Grade

Count

Shape

Weight

Grade

Type

Weight

Shape

Grade

Count

Center

Accent

<colgroup><col style="width:48pt" width="64"> </colgroup><tbody>
</tbody>

 

[hiker95]

IrishMist1748,


If this is what your raw data looks like:

Excel Workbook
	A
1	Type
2	Weight
3	Sizes
4	Gallery
5	Shape
6	Weight
7	Grade
8	Count
9	Shape
10	Weight
11	Grade
12	Type
13	Weight
14	Shape
15	Grade
16	Count
17	Center
18	Accent
19
Sheet1

What makes up a group?

What should the result look like?

And, explain your logic.

 

[IrishMist1748]

OK, I am sorry if I am confusing you all! What I meant to say is I need to create a macro in Excel 2003 that will search every row of a sheet for the words:

"Type", "Weight", "Sizes", "Gallery", "Shape", "Weight", "Grade", "Count", "Shape", "Weight", "Grade", "Type", "Weight", "Shape", "Grade", "Count", "Center", "Accent"

in that precise order and if it finds that sequence it will delete those rows (the entire sequence of 18 words and their rows). There is a total of about 70,000 rows with about 550 sets of these specific word sequences that need to be removed from my data. Thank you so much for your help! See below for examples of what I need done.

Below is simple sample of initial data:

Sheet1

*	A
1	aa
2	aa
3	aa
4	aa
5	aa
6	aa
7	aa
8	aa
9	aa
10	Type
11	Weight
12	Sizes
13	Gallery
14	Shape
15	Weight
16	Grade
17	Count
18	Shape
19	Weight
20	Grade
21	Type
22	Weight
23	Shape
24	Grade
25	Count
26	Center
27	Accent
28	bb
29	bb
30	Type
31	Weight
32	Sizes
33	Gallery
34	Shape
35	Weight
36	Grade
37	Count
38	Shape
39	Weight
40	Grade
41	Type
42	Weight
43	Shape
44	Grade
45	Count
46	Center
47	Accent
48	cc
49	cc
50	cc
51	cc
52	cc
53	Type
54	Weight
55	Sizes
56	Gallery
57	Shape
58	Weight
59	Grade
60	Count
61	Shape
62	Weight
63	Grade
64	Type
65	Weight
66	Shape
67	Grade
68	Count
69	Center
70	Accent
71	dd
72	dd
73	dd

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Below is how coloumne "A" should look after the macro runs:

Sheet1

*	A
1	aa
2	aa
3	aa
4	aa
5	aa
6	aa
7	aa
8	aa
9	aa
10	bb
11	bb
12	cc
13	cc
14	cc
15	cc
16	cc
17	dd
18	dd
19	dd

<tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

And again, below is pictured the 18 words listed in the order they should be in and only that order before those rows are delted:

Sheet1

*	A
1	Type
2	Weight
3	Sizes
4	Gallery
5	Shape
6	Weight
7	Grade
8	Count
9	Shape
10	Weight
11	Grade
12	Type
13	Weight
14	Shape
15	Grade
16	Count
17	Center
18	Accent

<colgroup><col style="font-weight:bold; width:30px; "><col style="width:64px;"></colgroup><tbody>
</tbody>

Excel tables to the web >> Excel Jeanie HTML 4

Forget the data below I could not figure out how to get it out of the document!

Sheet1

A
1	aa
2	aa
3	aa
4	aa
5	aa
6	aa
7	aa
aa
9	aa
10	bb
11	bb

<tbody>
</tbody>

 

[hiker95]

IrishMist1748,


Sample raw data:

Excel Workbook
	A
1	aa
2	aa
3	aa
4	aa
5	aa
6	aa
7	aa
8	aa
9	aa
10	Type
11	Weight
12	Sizes
13	Gallery
14	Shape
15	Weight
16	Grade
17	Count
18	Shape
19	Weight
20	Grade
21	Type
22	Weight
23	Shape
24	Grade
25	Count
26	Center
27	Accent
28	bb
29	bb
30	Type
31	Weight
32	Sizes
33	Gallery
34	Shape
35	Weight
36	Grade
37	Count
38	Shape
39	Weight
40	Grade
41	Type
42	Weight
43	Shape
44	Grade
45	Count
46	Center
47	Accent
48	cc
49	cc
50	cc
51	cc
52	cc
53	Type
54	Weight
55	Sizes
56	Gallery
57	Shape
58	Weight
59	Grade
60	Count
61	Shape
62	Weight
63	Grade
64	Type
65	Weight
66	Shape
67	Grade
68	Count
69	Center
70	Accent
71	dd
72	dd
73	dd
74	Type
75	Weight
76	Sizes
77	Gallery
78	Shape
79	Weight
80	Grade
81	Count
82	Shape
83	Weight
84	Grade
85	zz
86	zz
87	zz
88	zz
89
Sheet1

After the macro:

Excel Workbook
	A
1	aa
2	aa
3	aa
4	aa
5	aa
6	aa
7	aa
8	aa
9	aa
10	bb
11	bb
12	cc
13	cc
14	cc
15	cc
16	cc
17	dd
18	dd
19	dd
20	Type
21	Weight
22	Sizes
23	Gallery
24	Shape
25	Weight
26	Grade
27	Count
28	Shape
29	Weight
30	Grade
31	zz
32	zz
33	zz
34	zz
35
Sheet1

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, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Option Base 1
Sub Delete18()
' hiker95, 12/20/2012
' http://www.mrexcel.com/forum/excel-questions/676754-help-macro-will-delete-set-series-rows-column.html
Dim r As Long, rr As Long, fr As Long, n As Long
Dim s, i As Long, ii As Long, nn As Long
Application.ScreenUpdating = False
s = Array("Type", "Weight", "Sizes", "Gallery", "Shape", "Weight", "Grade", "Count", "Shape", "Weight", "Grade", "Type", "Weight", "Shape", "Grade", "Count", "Center", "Accent")
n = Application.CountIf(Columns(1), "Type")
For i = 1 To n Step 1
  fr = 0
  On Error Resume Next
  fr = Application.Match(s(1), Columns(1), 0)
  On Error GoTo 0
  If fr = 0 Then
    Application.ScreenUpdating = True
    Exit Sub
  Else
    nn = 0: ii = 0
    For r = fr To fr + 17 Step 1
      nn = nn + 1
      If Cells(r, 1) = s(nn) Then
        ii = ii + 1
      End If
    Next r
    If ii = 18 Then
      Rows(fr).Resize(18).Delete
    End If
  End If
Next i
Application.ScreenUpdating = True
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


Then run the Delete18 macro.

 

[IrishMist1748]

This works EXCEPT it seems to only take out the first 229 sets of the sequence. I need for it to function on the entire "A" column which is some 54,000 rows. I followed your directions to the letter! Is there something more I need to do?

Thank you!

 

[hiker95]

IrishMist1748,

The macro did work on the posted raw data.

Can I see your workbook with just column A's actual data?

You can upload your workbook to Box Net,
mark the workbook for sharing
and provide us with a link to your workbook.

 

[IrishMist1748]

OK, the link to the file is:

https://www.box.com/s/88fqkfe54eqw2v90b1oz

The file name is "Item Info Fields.xlsm"

Thanks again!

 

[hiker95]

IrishMist1748,

Thanks for the workbook.

The latest macro running against the 53,468 rows of raw data took 12.6 seconds to run.

541 groups of 18 rows per group = 9,738 rows deleted.



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

Option Explicit
Option Base 1
Sub Delete18V2()
' hiker95, 12/31/2012
' http://www.mrexcel.com/forum/excel-questions/676754-help-macro-will-delete-set-series-rows-column.html
Dim r As Long, lr As Long, rr As Long
Dim s, i As Long, n As Long, nd As Long
Application.ScreenUpdating = False
s = Array("Type", "Weight", "Sizes", "Gallery", "Shape", "Weight", "Grade", "Count", "Shape", "Weight", "Grade", "Type", "Weight", "Shape", "Grade", "Count", "Center", "Accent")
lr = Cells(Rows.Count, 1).End(xlUp).Row
nd = 0
For r = 1 To lr Step 1
  If Cells(r, 1) = "Type" Then
    n = 0: i = 0
    For rr = r To r + 17 Step 1
      n = n + 1
      If Cells(rr, 1) = s(n) Then
        i = i + 1
      End If
    Next rr
    If i = 18 Then
      Rows(r).Resize(18).Delete
      nd = nd + 1
    End If
    lr = Cells(Rows.Count, 1).End(xlUp).Row
  End If
Next r
Application.ScreenUpdating = True
MsgBox "There were " & nd & " groups deleted!"
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


Then run the Delete18V2 macro.

 

[Peter_SSs]

.. I need to create a macro in Excel 2003 that will search every row of a sheet ...

There is a total of about 70,000 rows ...

Excel 2003 doesn't have 70,000 rows.


I won't be downloading the sample file but you may wish to try this code, it should be somewhat faster.

I have assumed that there is only data in column A. If that assumption is incorrect, please advise about how many columns contain data.

This code is also flexible in that you could add/delete items from the series list & the code should automatically adjust.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Delete_Groups()<br>  <SPAN style="color:#00007F">Dim</SPAN> aGroupList, a, b<br>  <SPAN style="color:#00007F">Dim</SPAN> i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, j <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, k <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, m <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, rws <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, GroupSize <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>  <SPAN style="color:#00007F">Dim</SPAN> GroupStarted <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN><br><br>  <SPAN style="color:#00007F">Const</SPAN> sGroupList <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "Type, Weight, Sizes, Gallery, Shape, Weight, " _<br>                              & "Grade, Count, Shape, Weight, Grade, Type, " _<br>                              & "Weight, Shape, Grade, Count, Center, Accent"<br>  <br>  aGroupList = Split(sGroupList, ", ")<br>  GroupSize = <SPAN style="color:#00007F">UBound</SPAN>(aGroupList) + 1<br>  <SPAN style="color:#00007F">With</SPAN> Range("A1", Range("A" & Rows.Count).End(xlUp))<br>    a = .Value<br>    rws = <SPAN style="color:#00007F">UBound</SPAN>(a, 1)<br>    <SPAN style="color:#00007F">ReDim</SPAN> b(1 <SPAN style="color:#00007F">To</SPAN> rws, 1 <SPAN style="color:#00007F">To</SPAN> 1)<br>    <SPAN style="color:#00007F">For</SPAN> i = 1 <SPAN style="color:#00007F">To</SPAN> rws<br>      <SPAN style="color:#00007F">If</SPAN> GroupStarted <SPAN style="color:#00007F">Then</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> a(i, 1) = aGroupList(j) <SPAN style="color:#00007F">Then</SPAN><br>          j = j + 1<br>          <SPAN style="color:#00007F">If</SPAN> j = GroupSize <SPAN style="color:#00007F">Then</SPAN><br>            GroupStarted = <SPAN style="color:#00007F">False</SPAN><br>          <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Else</SPAN><br>          <SPAN style="color:#00007F">For</SPAN> m = i - j <SPAN style="color:#00007F">To</SPAN> i - 1<br>            k = k + 1<br>            b(k, 1) = a(m, 1)<br>          <SPAN style="color:#00007F">Next</SPAN> m<br>          i = i - 1<br>          GroupStarted = <SPAN style="color:#00007F">False</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">Else</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> a(i, 1) = aGroupList(0) <SPAN style="color:#00007F">Then</SPAN><br>          GroupStarted = <SPAN style="color:#00007F">True</SPAN><br>          j = 1<br>        <SPAN style="color:#00007F">Else</SPAN><br>          k = k + 1<br>          b(k, 1) = a(i, 1)<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>      <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> i<br>    .Value = b<br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[hiker95]

Peter_SSs,

WOW - very, very fast = 0.484 seconds.

One for my archives.

Thanks, and Happy New Year.