Delete/Add Rows from referenced Worksheet

[Don Black]

I am currently using a macro that deletes a row out of a worksheet based on the "#REF", error. Which works great the only problem is that after this is completed I need another macro that would copy the formula from the row above and create 10, additional rows, so that when new data is entered from the main worksheet it will populate in this formatted worksheet.

here is the macro to delete the rows:

Private Sub Worksheet_Calculate()
    Dim rFound As Range, rDelete As Range
    Dim sAddress As String

    Application.ScreenUpdating = False

    With Columns("A")
        Set rFound = .Find(What:="#REF", After:=.Resize(1, 1), SearchOrder:=xlByRows)

        If Not rFound Is Nothing Then
            Set rDelete = rFound
            Do
                Set rDelete = Union(rDelete, rFound)
                Set rFound = .FindNext(rFound)
            Loop While rFound.Row > rDelete.Row
        End If

        If Not rDelete Is Nothing Then rDelete.EntireRow.Delete

    End With

    Application.ScreenUpdating = True

End Sub

The tab titled "Scrap Activity Log" is where my formulas and the macro currently reside. Not sure if I should have used a regular module or keep it in the worksheet. The tab "New Inventory as of 12-2013," is my main data.

 

[Hui]

what about adding a single line like:

Range("A" & Range("A1").End(xlDown).Row).Resize(, 21).Copy Range("A" & Range("A1").End(xlDown).Row + 1).Resize(10, 21)

 

[Don Black]

where am I putting this code.

 

[Hui]

Private Sub Worksheet_Calculate()
  Dim rFound As Range, rDelete As Range
  Dim sAddress As String
  Dim Deleted As Boolean
   
  Application.ScreenUpdating = False
   
  Deleted = False
  With Columns("A")
  Set rFound = .Find(What:="#REF", After:=.Resize(1, 1), SearchOrder:=xlByRows)

  If Not rFound Is Nothing Then
  Set rDelete = rFound
  Do
  Set rDelete = Union(rDelete, rFound)
  Set rFound = .FindNext(rFound)
  Loop While rFound.Row > rDelete.Row
  End If

  If Not rDelete Is Nothing Then
  rDelete.EntireRow.Delete
  Deleted = True
  End If

  End With
   
  If Deleted Then
  Range("A" & Range("A1").End(xlDown).Row).Resize(, 21).Copy Range("A" & Range("A1").End(xlDown).Row + 1).Resize(10, 21)
  End If

  Application.ScreenUpdating = True

End Sub

 

[Don Black]

@Hui,


this works fantastically, my only problem is that when the new cells are created the Page Break Preview border does not expand. Disabling the back button unless I drag the border down is there anyway to make that expand when the formulated cells are populated.