VBA to insert rows between groups, add group header, and delete repeating values below header.

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116
A while back, users Peter_SSs and Jazzed provided me some excellent feedback on how to insert a blank row after repeating cell values in a column. Click here to see the original thread.

Now I have a similar question, but it’s a little more complex. Rather than explain here, I’ll graph what I need below. Basically the Widgets are illustrated in column A, and the alpha characters (e.g. "adb") are all listed in column B.

Do any of you VBA experts have any suggestions on how I can get from my raw data to step 3 showing the expected results below?

raw data...
-----A Column----B Column
1
2---Widget1-----adb
3---Widget1-----klp
4---Widget1-----qpf
5---Widget2-----mes
6---Widget2-----xrz
7---Widget2-----uyr
8---Widget3-----dst
9---Widget3-----umn
10--Widget3-----kqh
11--Widget3-----vys

Step 1...(code starts by inserting two blank rows between groups)
-----A Column----B Column
1
2---Widget1-----adb
3---Widget1-----klp
4---Widget1-----qpf
5
6
7---Widget2-----mes
8---Widget2-----xrz
9---Widget2-----uyr
10
11
12--Widget3-----dst
13--Widget3-----umn
14--Widget3-----kqh
15--Widget3-----vys


Step 2...(code copies the first field in each group and pastes it directly above in the blank line and formats it to be bold face.)
-----A Column----B Column
1---Widget1
2---Widget1-----adb
3---Widget1-----klp
4---Widget1-----qpf
5
6---Widget2
7---Widget2-----mes
8---Widget2-----xrz
9---Widget2-----uyr
10
11---Widget3
12--Widget3-----dst
13--Widget3-----umn
14--Widget3-----kqh
15--Widget3-----vys


Step 3...(code deletes the repeating cells just below the header it just created back in step 2.)
-----A Column----B Column
1---Widget1
2-----------------adb
3-----------------klp
4-----------------qpf
5
6---Widget2
7-----------------mes
8-----------------xrz
9-----------------uyr
10
11---Widget3
12---------------dst
13---------------umn
14---------------kqh
15---------------vys


So step 3 is how the raw data would look after the code has been executed. Hope this makes sense. Thanks again for any feedback! :)
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,456
Office Version
  1. 365
Platform
  1. Windows
Building on the previous code ...

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>    <SPAN style="color:#00007F">Dim</SPAN> Aarea <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Range("A1", Range("A" & Rows.Count).End(xlUp))<br>        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _<br>            Replace:=True, PageBreaks:=False, SummaryBelowData:=<SPAN style="color:#00007F">True</SPAN><br>        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents<br>        .Offset(, -1).EntireColumn.Delete<br>        .EntireColumn.RemoveSubtotal<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Aarea <SPAN style="color:#00007F">In</SPAN> Columns("A").SpecialCells(xlCellTypeConstants).Areas<br>        <SPAN style="color:#00007F">With</SPAN> Aarea<br>            <SPAN style="color:#00007F">With</SPAN> .Cells(1, 1).Offset(-1)<br>                .Value = .Offset(1).Value<br>                .Font.Bold = <SPAN style="color:#00007F">True</SPAN><br>                .EntireRow.Insert<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            .ClearContents<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> Aarea<br>    Rows(1).Delete<br>    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>
 

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116
Hi Peter, thank you so much for the fast reply! Sorry it has taken me so long to respond. I have been offline for a few days (crazy week).

Anyhow, I tested your code and I get a Run-time error '1004' stating "Application-defined or object-defined error". The code that it singles out as being the issue is notated below.

Code:
With .Cells(1, 1).Offset(-1)
Any ideas on how to correct this? Thanks again so much. I really, really, really appreciate it!!! :biggrin:

KP
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,456
Office Version
  1. 365
Platform
  1. Windows
Anyhow, I tested your code and I get a Run-time error '1004' stating "Application-defined or object-defined error". The code that it singles out as being the issue is notated below.

Code:
With .Cells(1, 1).Offset(-1)
Any ideas on how to correct this? Thanks again so much. I really, really, really appreciate it!!! :biggrin:

KP
I don't get the error. My guess is that your row 1 is not empty, even though your posted sample had row 1 empty. Could that be the problem?
 

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116

ADVERTISEMENT

I think I identified the problem. Instead of my data starting from Row A2 (as per my example), my data starts from A11. So I modified your code to reflect A10 instead of A1.

Code:
With Range("A13", Range("A" & Rows.Count).End(xlUp))
I tried running it on a sheet that had no contents above it and it ran perfectly. However, the error seems to only be firing when I have contents in cells A1-A9. It appears it has something to do with End(xlUp) in the code.

Is there anyway to program the code not to look at anything above A10 (which is my blank starting line that the first offset will be populated with). Hope this makes sense. Thanks again, you have been a tremendous help! :)

KP
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,456
Office Version
  1. 365
Platform
  1. Windows
I think I identified the problem. Instead of my data starting from Row A2 (as per my example), my data starts from A11. So I modified your code to reflect A10 instead of A1.

Code:
With Range("A13", Range("A" & Rows.Count).End(xlUp))
I tried running it on a sheet that had no contents above it and it ran perfectly. However, the error seems to only be firing when I have contents in cells A1-A9. It appears it has something to do with End(xlUp) in the code.

Is there anyway to program the code not to look at anything above A10 (which is my blank starting line that the first offset will be populated with). Hope this makes sense. Thanks again, you have been a tremendous help! :)

KP
Try this (it does assume there will be some data below A10)

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Rearrange()<br>    <SPAN style="color:#00007F">Dim</SPAN> Aarea <SPAN style="color:#00007F">As</SPAN> Range, Arange <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> Arange = Range("A10", Range("A" & Rows.Count).End(xlUp))<br>    <SPAN style="color:#00007F">With</SPAN> Arange<br>        .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(1), _<br>            Replace:=True, PageBreaks:=False, SummaryBelowData:=<SPAN style="color:#00007F">True</SPAN><br>        .Offset(2, -1).SpecialCells(xlCellTypeConstants).Offset(, 1).ClearContents<br>        .Offset(, -1).EntireColumn.Delete<br>        .EntireColumn.RemoveSubtotal<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> Aarea <SPAN style="color:#00007F">In</SPAN> Arange.SpecialCells(xlCellTypeConstants).Areas<br>        <SPAN style="color:#00007F">With</SPAN> Aarea<br>            <SPAN style="color:#00007F">With</SPAN> .Cells(1, 1).Offset(-1)<br>                .Value = .Offset(1).Value<br>                .Font.Bold = <SPAN style="color:#00007F">True</SPAN><br>                .EntireRow.Insert<br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>            .ClearContents<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> Aarea<br>    Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br><br><br></FONT>
 

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116

ADVERTISEMENT

Terrific!!!! Once again you solved it!!! Thanks again so much for your follow-up on this. Cheers!!!!

:biggrin:

KP
 

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116
Hi Peter, I have one more question concerning this outstanding block of code you supplied me. Is there a way to reverse it? I don't mean "undo", I literally mean reverse.

The reason why I'm looking to reverse it is because I'd like to import it back into an access database table after it has been reviewed in excel. If possible, that'd be great! Thanks for any suggestions. :)

KP
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
49,456
Office Version
  1. 365
Platform
  1. Windows
Not sure I have the row deletions exactly correct so definitely use a copy to test.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Reverse_Rearrange()<br>    <SPAN style="color:#00007F">Dim</SPAN> bRng <SPAN style="color:#00007F">As</SPAN> Range, bArea <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">Set</SPAN> bRng = Range("B11", Range("B" & Rows.Count).End(xlUp))<br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> bArea <SPAN style="color:#00007F">In</SPAN> bRng.SpecialCells(xlCellTypeConstants).Areas<br>        <SPAN style="color:#00007F">With</SPAN> bArea<br>            .Offset(, -1).Value = .Resize(1).Offset(-1, -1).Value<br>            .Resize(1).Offset(-1, -1).Clear<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> bArea<br>    bRng.SpecialCells(xlCellTypeBlanks).EntireRow.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>
 

KP_SoCal

Board Regular
Joined
Nov 17, 2009
Messages
116
Genius!!! Absolute genius!!! That worked marvelously!!!

The only small issue that I had with Sub Rearrange() is that is copies into row 10 the formatting and row height from row 9. But not the end of the world. I plugged this piece of code at the end of your code and it did the trick. :biggrin:
Code:
Rows("10:10").Clear
Rows("10:10").RowHeight = 15
Anyways, beautiful work!!! As always, thanks Peter for your help! :biggrin:

KP
 

Forum statistics

Threads
1,136,845
Messages
5,678,103
Members
419,742
Latest member
Dropzyl88

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
Top