insert new row automatically

[maxx21]

I created a form in which I can enter data that is totaled at the end. Is there a possibility that a new row is inserted at the end of the form automatically every time I enter data in the last field?

 

[Damon Ostrander]

Hi maxx21,

Yes, this is easy to do with a simple worksheet event. For example, the following code will add a row each time something is entered into the row just prior to the total. In this example, I gave the cell containing the total formula a name ("TotalVal") so that as it moves down the code will always be able to find it. To name a cell, just select it and type a name in the Name Box just above cell A1.

Here's the code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = [TotalVal].Row - 1 Then
[TotalVal].EntireRow.Insert
End If
End Sub

Just put this code in the worksheet's event code module. To do this, right-click on the worksheet tab, select View Code, and paste into the code pane. Then enjoy.

 

[joker961]

hi damon

i have a problem here, each time i put on the code and go to the worksheet and add a number before the "totalval" cell it insert too many rows and the excel crashs, it stops and close. any other code you can help me with , thank you.

 

[RoryA]

Try this version:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = [TotalVal].Row - 1 Then
      Application.EnableEvents = False
      [TotalVal].EntireRow.Insert
      Application.EnableEvents = True
   End If
End Sub

 

[joker961]

thanks man it did the work exaclty i have one more question , if i'm in the same worksheet and i emptied the row before the empty cell, is there a code to delete the empty cell row so i can only have just 1 empty cell instead of 2 ( or more in case i deleted more)
i tired some thing like this and hoped that would work but it didnt ( in addition to the one you sent earlier

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = [TotalVal].Row - 1 Then
      Application.EnableEvents = False
      [TotalVal].EntireRow.Insert
      Application.EnableEvents = True
   End If
If Target.Row = [TotalVal].Row - 2 Then
      Application.EnableEvents = False
      [TotalVal].EntireRow.delete
      Application.EnableEvents = True
   End If
End Sub

thanks a lot for you help

 

[RoryA]

I'm not 100% clear on what you want, but perhaps:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rCell                       As Range
   
   If Not Intersect(Target, Range("TotalVal").EntireColumn) Is Nothing Then
      
      Application.EnableEvents = False
      For Each rCell In Intersect(Target, Range("TotalVal").EntireColumn).Cells
         
         If rCell.Row = Range("TotalVal").Row - 1 Then
            If Len(rCell.Value) > 0 Then
               Range("TotalVal").EntireRow.Insert
            Else
               rCell.EntireRow.Delete
            End If
         ElseIf Len(rCell.Value) = 0 Then
            rCell.EntireRow.Delete
         End If
         
      Next rCell
      Application.EnableEvents = True
      
   End If
End Sub

 

[joker961]

[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD]1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[/TR]
[TR]
[TD]3[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]6(sum)[/TD]
[/TR]
</tbody>[/TABLE]

if i add in the empty cell it would became like this
[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD]1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[/TR]
[TR]
[TD]3[/TD]
[/TR]
[TR]
[TD]4[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]10(sum)[/TD]
[/TR]
</tbody>[/TABLE]

and if i delete or empty the 3rd cell from the original table it would be like this
[TABLE="class: grid, width: 50"]
<tbody>[TR]
[TD]1[/TD]
[/TR]
[TR]
[TD]2[/TD]
[/TR]
[TR]
[TD][/TD]
[/TR]
[TR]
[TD]3(sum)[/TD]
[/TR]
</tbody>[/TABLE]
is there any chance that the formula stick on the sum cell , thanks

 

[RoryA]

Sorry - there was a typo in the code above, which I have now corrected. The ElseIf line should have been:

ElseIf Len(rCell.Value) = 0 Then

rather than:

ElseIf Len(rCell.Value) > 0 Then

If you alter your sum formula to be:
=SUM(A1:INDIRECT("R[-1]C",0))
it will automatically adjust.

 

[RoryA]

Amended code as the previous version doesn't always delete all rows properly:

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rCell                       As Range
   Dim rDelete                     As Range
   If Not Intersect(Target, Range("TotalVal").EntireColumn) Is Nothing Then

      Application.EnableEvents = False
      For Each rCell In Intersect(Target, Range("TotalVal").EntireColumn).Cells

         If rCell.Row = Range("TotalVal").Row - 1 Then
            If Len(rCell.Value) > 0 Then
               Range("TotalVal").EntireRow.Insert
            Else
               If rDelete Is Nothing Then
                  Set rDelete = rCell
               Else
                  Set rDelete = Union(rDelete, rCell)
               End If
            End If
         ElseIf Len(rCell.Value) = 0 Then
            If rDelete Is Nothing Then
               Set rDelete = rCell
            Else
               Set rDelete = Union(rDelete, rCell)
            End If
         End If

      Next rCell
      If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
      Application.EnableEvents = True

   End If
End Sub

 

[uncletim]

Try this version:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Row = [TotalVal].Row - 1 Then
      Application.EnableEvents = False
      [TotalVal].EntireRow.Insert
      Application.EnableEvents = True
   End If
End Sub

Found this in an internet search, and it appears to solve half of my problem. I need to automatically insert rows in the middle of a fillable excel form which I have created (excel 2000), while preserving the formatting of the previous row (merged cells, borders, font, etc). Also, the sheet is protected while in use, with only writeable fields unprotected. Is this even possible?

Any advice welcomed.