Automatically insert a row if a cell is typed into?

[greyscout]

I was working on a spreadsheet (Excel 97) and every time I would type into a cell in Column A, it would automatically insert a new row above the given cell. This was a good thing! It would keep the amount of empty rows above my typing the same. I guess, at some point, I deleted a macro or something because now it doesn't do it anymore and I'm at a loss for how to bring it back. I assume this is either a macro or an add-in. Any help would be much appreciated.

 

[greyscout]

Picture 5 rows (1-5). Consider Row 3 to be already full of data.

Cell A5 would be "ToolingData_Table_End", which was addressed in the original post. The original code made it so, when I would type into cell A4, a new row would insert above cell A5.

Now, my guess is that I need to name cell A1 something like "ToolingData_Table_Start" and create a code (which shouldn't be much different from the original code) that, when I would type in cell A2, inserts a new row over A2.

 

[Joe4]

Just spitballing, but maybe something like:

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

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

         If rCell.Row = Range("ToolingData_Table_End").Row - 1 Then
            If Len(rCell.Value) > 0 Then
               Range("ToolingData_Table_End").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
   

'New
   If Not Intersect(Target, Range("ToolingData_Table_Start").EntireColumn) Is Nothing Then

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

         If rCell.Row = Range("ToolingData_Table_Start").Row - 1 Then
            If Len(rCell.Value) > 0 Then
               Range("ToolingData_Table_Start").Offset(-1, 0).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

 

[greyscout]

No bueno.

 

[Joe4]

OK. I will stop trying to edit/update other people's code now and hopefully Mechixx will see it and reply.

 

[greyscout]

OK. I will stop trying to edit/update other people's code now and hopefully Mechixx will see it and reply.

Thanks anyway. Valiant attempt.