VBA to Insert Row if non Blank

Endeavouring

Board Regular
Joined
Jun 30, 2010
Messages
115
Hi

I have a database that hs a column with a marker in one column , lets call it column D the marker denotes the start of a new record. I need to insert a blank row above each marker.

Any ideas ?
 

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.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,564
Office Version
  1. 365
Platform
  1. Windows
Manual or macro approach?

Manual: See if steps 1-7 of post #2 here can be adapted for your use.

Macro: Try this on a copy of your workbook.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> RowAboveMarker()<br>    <SPAN style="color:#00007F">Const</SPAN> Marker <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "xx" <SPAN style="color:#007F00">'<-- Change to suit your marker</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> MarkerFound <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> FirstAddress <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Range("D1", Range("D" & Rows.Count).End(xlUp))<br>        <SPAN style="color:#00007F">Set</SPAN> MarkerFound = .Find(What:=Marker, After:=.Cells(1, 1), LookIn:=xlValues, _<br>            LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)<br>        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> MarkerFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            FirstAddress = MarkerFound.Offset(1).Address<br>            <SPAN style="color:#00007F">Do</SPAN><br>                MarkerFound.EntireRow.Insert<br>                <SPAN style="color:#00007F">Set</SPAN> MarkerFound = .FindNext(After:=MarkerFound)<br>            <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> MarkerFound.Address <> FirstAddress<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 

Endeavouring

Board Regular
Joined
Jun 30, 2010
Messages
115
Peter SSs

Thought I'd be smart and see if I could put the blank row after the marker
so duly tried changing

MarkerFound.EntireRow.Insert

To

MarkerFound.Offset(1).EntireRow.Insert

but with horific results, the system hung

Why ?
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,564
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

What happened to you is that the system did not really hang, but instead the code got in an endless loop. The code keeps finding a marker and inserting rows until it returns and finds the first marker, that's why we recorded 'FirstAddress = ...'

Inserting the row before the marker moves the marker down one row and that is why I recorded
Rich (BB code):
FirstAddress = MarkerFound.Offset(1).Address

Now that you are inserting the row below the marker, the (first) marker will not move so, in this case we need to remove that red text from that line of code.

Also, just as a general guide, I always like to test on a small sample of data and step through the code a line at a time with F8. That way you get a better idea of what is happening and usually see if there is an endless loop problem.
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
48,564
Office Version
  1. 365
Platform
  1. Windows
Hi

Removed the .Offset(1) but it made no difference
Not sure what you have done, but you need to make two changes to the original code.
1. Move the .Offset to where you did try, and
2. Delete the .Offset as per my previous post.


This code works for me.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> RowBelowMarker()<br>    <SPAN style="color:#00007F">Const</SPAN> Marker <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "xx" <SPAN style="color:#007F00">'<-- Change to suit your marker</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> MarkerFound <SPAN style="color:#00007F">As</SPAN> Range<br>    <SPAN style="color:#00007F">Dim</SPAN> FirstAddress <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Range("D1", Range("D" & Rows.Count).End(xlUp))<br>        <SPAN style="color:#00007F">Set</SPAN> MarkerFound = .Find(What:=Marker, After:=.Cells(1, 1), LookIn:=xlValues, _<br>            LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)<br>        <SPAN style="color:#00007F">If</SPAN> <SPAN style="color:#00007F">Not</SPAN> MarkerFound <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN><br>            FirstAddress = MarkerFound.Address <SPAN style="color:#007F00">'<-- Change 1</SPAN><br>            <SPAN style="color:#00007F">Do</SPAN><br>                MarkerFound.Offset(1).EntireRow.Insert <SPAN style="color:#007F00">'<-- Change 2</SPAN><br>                <SPAN style="color:#00007F">Set</SPAN> MarkerFound = .FindNext(After:=MarkerFound)<br>            <SPAN style="color:#00007F">Loop</SPAN> <SPAN style="color:#00007F">While</SPAN> MarkerFound.Address <> FirstAddress<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 

Endeavouring

Board Regular
Joined
Jun 30, 2010
Messages
115
Hi Peter

My only excuse is tha it was 3am over here and I didn't make the second change.

Works like a dream

Many thanks
 

Watch MrExcel Video

Forum statistics

Threads
1,130,169
Messages
5,640,550
Members
417,151
Latest member
ChickenTenderer

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