Adding Rows in Excel 2003 with VBA Help Required

[TechTank]

Hello,

I'm trying to insert a row and copy data into that row below a row in Column A where the cell value is 0. The code I'm using is below and works for the first two row insertions.

However the 3rd and subsequent executions add a row inbetween the 1st Row and the 2nd and not after the last row that contains the value "0" in Column A.

I cannot use the "find last row with data" function as I have data further on in the sheet. Any help you can give is greatly appreciated.

### Code Begins ###

Option Explicit
Option Compare Text
Sub InsertRow()
Dim rFind As Long
'On Error Resume Next
 
'Selects the 'Project Phase' from the 'Cover Sheet'
Sheets("Cover Sheet").Select
Range("B27").Select
Application.CutCopyMode = False
Selection.Copy
 
'Selects the 'Format Control' Sheet and 'Project Phase' Cell
Sheets("Format Control").Select
Range("B4").Select
 
'Pastes the 'Project Phase' from the 'Cover Sheet'
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
'Selects Row To Be Copied
Rows("4:4").Select
 
'Copies Entire Row Selected Above
Selection.Copy
 
'Selects the 'Environment Information' Sheet
Sheets("Environment Information").Select
 
'Looks for the value '0' in Column A from Cell A5 and down.
rFind = Columns("A:A").Find(What:="0", After:=Range("A5"), LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Row
 
If rFind > 0 Then Rows(rFind + 1).Insert xlShiftDown
 
Cells(rFind + 1, 2).Select
 
End Sub

### Code Ends ###

My knowledge of VBA is minimal to be honest and I combined this code from various sources I'd found on the internet (and some very helpful members from these forums @energman58 @Peter SSs) but if anyone has any suggestions I would be very grateful.

Thank you for reading and any possible help you can give.

 

[TechTank]

* Bumped From Page 4*

 

[TechTank]

*Update*

I think the problem I am having is this part of my code:

If rFind > 1 Then Rows(rFind + 1).Insert xlShiftDown

I think that when it finds the row With '1' in it it inserts a row 1 row under the first row it finds with a '1' in it. If there is a row underneath the 1st row with a '1' in it then it inserts and pushes that row down.

<table style="width: 726px; height: 88px;" border="0" cellpadding="0" cellspacing="0"><col style="mso-width-source:userset;mso-width-alt:725;width:13pt" width="17"> <col style="mso-width-source:userset;mso-width-alt:5120;width:90pt" width="120"> <col style="mso-width-source:userset;mso-width-alt:5333;width:94pt" width="125"> <col style="mso-width-source:userset;mso-width-alt:7381;width:130pt" width="173"> <col style="mso-width-source:userset;mso-width-alt:7210;width:127pt" width="169"> <col style="mso-width-source:userset;mso-width-alt:6186;width:109pt" width="145"> <col style="mso-width-source:userset;mso-width-alt:12117;width:213pt" width="284"> <tbody><tr style="height:16.5pt" height="22"> <td class="xl25" style="height:16.5pt; width:13pt" align="right" height="22" width="17">1</td> <td class="xl30" style="width:90pt" width="120">Project Phase</td> <td class="xl31" style="border-left:none;width:94pt" width="125">Server Type</td> <td style="vertical-align: top;">
</td> </tr> <tr style="height:16.5pt" height="22"> <td class="xl24" style="height:16.5pt" align="right" height="22">1</td> <td class="xl26" style="border-top:none">Performance Test</td> <td class="xl29" style="border-top:none none;mso-ignore:style;background:#FF9900; mso-pattern:auto none"> </td> <td style="vertical-align: top;">
</td> </tr> <tr style="height:16.5pt" height="22"> <td class="xl24" style="height:16.5pt" align="right" height="22">1</td> <td class="xl26" style="border-top:none">LIVE</td> <td class="xl29" style="border-top:none none;mso-ignore:style;background:#FF9900; mso-pattern:auto none"> </td> <td style="vertical-align: top;">
</td> </tr> </tbody></table>
I'm not sure if you can see from the above but 'LIVE' was the first row entered with the macro and 'Performance Test' was the second however Performance Test is first in the list as 'LIVE' has been pushed down with the insert. The first '1' is on the header row along with 'Project Phase' and 'Server Type'.

I hope this helps someone to understand what I am trying to do with this code.

Thank you for your time.

 

[Peter_SSs]

I'm trying to insert a row and copy data into that row below a row in Column A where the cell value is 0. The code I'm using is below and works for the first two row insertions.

However the 3rd and subsequent executions add a row inbetween the 1st Row and the 2nd

That is not happening for me. It keeps adding the new row immediately below the first row that contains a '0'

.. and not after the last row that contains the value "0" in Column A.

What does the last row with '0' have to do with it? You haven't said anything about that anywhere that I can see.

*Update*

I think the problem I am having is this part of my code:

If rFind > 1 Then Rows(rFind + 1).Insert xlShiftDown

I think that when it finds the row With '1' in it ..

What does finding a '1' have to do with it - you were previously looking for a '0'?

I hope this helps someone to understand what I am trying to do with this code.

I'm afraid that I'm struggling to understand what you have in your sheets and just what you are trying to achieve.

 

[TechTank]

Sorry Peter,

I'm trying to achieve the following:

Have Excel find the last cell that contains the value of '0' on a sheet. When it finds that '0' (it'll be in Column A) I want it to insert 1 row beneath the row where it found the last '0'. The row it will be inserting is a copied row from another sheet that it copied earlier in the macro. The row that is copied has a '0' in column A so that I can (in theory) run the code time and again and it will insert the copied row under the last '0' entry in column A.

The 1's were from another macro but trying to accomplish the same thing using the number '1' as a reference for Excel to search for and do the same as above.

I have three areas on the one sheet that I am trying to get this to work on using the values 0,1, and 2.

I hope that makes it a little clearer of what I'm trying to achieve and sorry for the '1' references in my updated post.

 

[TechTank]

I believe I have found an answer to my problem . This seems to do exactly what I want it too and hope it may help someone else (the main code for the Row Insertion is in bold but I've included the rest of the code for reference to anyone wishing to use it):

Option Explicit
Option Compare Text
 
Sub Insert_Row_Under_Last_0()

Dim rng As Range
On Error Resume Next
 
'Disables Sheet Protection
    ActiveSheet.Unprotect
 
'Prevent Prompting
    Application.DisplayAlerts = False
 
'Stop Updating of The Screen To Optimise Speed
    Application.ScreenUpdating = False
 
'Selects the 'Project Phase' from the 'Cover Sheet'
    Sheets("Cover Sheet").Select
        Range("B27").Select
            Application.CutCopyMode = False
               Selection.Copy
        Range("B10").Select
               
'Selects the 'Format Control' Sheet and 'Project Phase' Cell
    Sheets("Format Control").Select
        Range("B4").Select
        
'Pastes the 'Project Phase' from the 'Cover Sheet'
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
    
'Selects Row To Be Copied
    Rows("4:4").Select
    
'Copies Entire Row Selected Above
    Selection.Copy
 
[B]'Looks for the last value '0' in Column A from Cell A5 and down.
            With Sheets("Environment Information").Range("A:A")
                Set rng = .Find(What:="0", After:=.Cells(1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
                    If Not rng Is Nothing Then
                Application.Goto rng, True
    End If
End With[/B]
 
[B]'Selects the row below the last value '0'[/B]
[B]ActiveCell.Offset(1, 0).Select
    Selection.Insert Shift:=xlDown[/B]
        
'Enable Prompting
    Application.DisplayAlerts = True
    
'Update The Screen
    Application.ScreenUpdating = True
 
'Enables Sheet Protection
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
    , AllowInsertingRows:=True, AllowDeletingRows:=True
 
'Selects the 3rd cell in the new row
    ActiveCell.Offset(0, 2).Select
 
'Scrolls to the top of the window
    ActiveWindow.SmallScroll Down:=-1000
 
End Sub

If anyone can improve this code or has some pointers then please let me know but up to this point I'm doing a little dance with a little shuffle thrown in.

Thank you to @energman58 and @Peter SSs for their patience and expertise. Without you I wouldn't have gotten off of the starting blocks.

 

[Peter_SSs]

I'm not certain about all things in your sheets/code, but since I mentioned in your other thread about trying to avoid too much selecting, here is another code you may wish to try (in a copy of your workbook), and study to understand how it works without selections.

It has only 1 'select' and that is selecting the second cell of the newly inserted row. I'm not sure why you are doing that, but I assume there is a reason so I have left that in.

I have also assumed -
- that 'Environment Information' is the active sheet when the code is run.
- that a '0' will always be found in column A

If any assumption is incorrect, a bit more information about it would be helpful.

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> Insert_Row_Under_Last_0_v2()<br>    <SPAN style="color:#00007F">Dim</SPAN> rng <SPAN style="color:#00007F">As</SPAN> Range<br>    <br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    Sheets("Format Control").Range("B4").Value = _<br>        Sheets("Cover Sheet").Range("B27").Value<br>    <SPAN style="color:#00007F">With</SPAN> Sheets("Environment Information")<br>        .Unprotect<br>        <SPAN style="color:#00007F">Set</SPAN> rng = .Columns("A").Find(What:="0", After:=.Cells(1, 1), _<br>            LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlPrevious, _<br>            MatchCase:=False, SearchFormat:=False)<br>        Sheets("Format Control").Rows(4).Copy<br>        rng.Offset(1).EntireRow.Insert<br>        rng.Offset(1, 1).Select<br>        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=<SPAN style="color:#00007F">True</SPAN>, _<br>            AllowInsertingRows:=True, AllowDeletingRows:=True<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    ActiveWindow.ScrollRow = 1<br>    Application.ScreenUpdating = True<br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br><br></FONT>

 

[TechTank]

Hi Peter SSs,

That code does exactly what I was after and is a lot shorter. I did try removing all the Selects as suggested but kept coming up against an error. I was trying to use "With Sheets("Environment Information").Range("A:A")" as an example to base my other Selects on but I will certainly be studying your code and implementing it.

Your assumptions were correct. The offset is required as the row copied and inserted has some information auto-populated in previous steps so the User will only need to be in the offset cell after clicking the button to insert the row.

Thank you for your patience and continued help, it's very much appreciated.

Mark.