How to delete previous rows

Option Explicit


Sub Main()
Application.ScreenUpdating = False
Application.DisplayAlerts = False


Dim wbDest As Workbook
Dim wscopy As Worksheet
Dim wsDest As Worksheet
Dim wsPath As Worksheet
Dim wbCopy As Workbook
Dim CopyLastRow As Long
Dim destlastrow As Long
Dim pathslastrow As Long
Dim rowscopied As Long
Dim WbArray() As Variant
Dim pathrng As Range
Dim lastrow As Long
Dim RngDelete As Range


'Unprotect Sheet
Call UnprotectSheet


'Set variables for destination workbook (Master Register)
Set wbDest = Workbooks("Package Summary_KY_01.xlsm")
Set wsDest = wbDest.Worksheets("Data")
Set wsPath = wbDest.Worksheets("SCA")


'Clear existing filter
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0


'Find the last row in the destination sheet & delete all rows (except rows 1 & 2)
lastrow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
If Not lastrow = 1 Then
Set RngDelete = wsDest.Range(wsDest.Cells(4, 1), wsDest.Cells(lastrow, 1))
RngDelete.Select
Call InsertDeleteRows.DeleteRows("update")
Application.ScreenUpdating = False
End If
Range("A4:V4").ClearContents


'This is the loop where each SCA workbook is opened and data is copied to the master from each workbook
Call LoopEachWb(wbDest:=wbDest, wsDest:=wsDest, wsPath:=wsPath)


'Copy and paste and formulated columns (Columns J and M) in the master register
Range("copy_block_1").Copy
Range("paste_block_1").PasteSpecial
Range("copy_block_2").Copy
Range("paste_block_2").PasteSpecial
Application.CutCopyMode = False


'Select cell A1
Range("A2").Select


'Re-protect sheet
Call ProtectSheet


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub




Sub LoopEachWb(ByRef wbDest As Workbook, ByRef wsDest As Worksheet, ByRef wsPath As Worksheet)
Dim CopyLastRow As Long
Dim rowscopied As Long
Dim pathslastrow As Long
Dim pathrng As Range
Dim path As Range
Dim wbCopy As Workbook
Dim wscopy As Worksheet
Dim destlastrow As Long


'Get paths from the Paths sheet.
pathslastrow = wsPath.Cells(wsPath.Rows.Count, "A").End(xlUp).Row
Set pathrng = wsPath.Range(wsPath.Cells(2, 1), wsPath.Cells(pathslastrow, 1))


For Each path In pathrng
'Open SCA Workbook and set variable for copy workbook and copy sheet (SCA Workbook)
Workbooks.Open (path.Value)
Set wbCopy = ActiveWorkbook  'ActiveWorkbook is the new wb just opened (SCA Workbook)
Set wscopy = wbCopy.Worksheets("Data")


'Find the last row in the copy range based on data in column Al
CopyLastRow = wscopy.Cells(wscopy.Rows.Count, "A").End(xlUp).Row
rowscopied = CopyLastRow - 2


'Find first blank row in the destination range based on data in column A and offset by 1 row
destlastrow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Row
If destlastrow = 1 Then
wsDest.Activate
Range("A3").Select
'In this case there is no data in the master sheet, there is already an existing row, therefore the rows inserted is RowsCopied - 1
Call InsertDeleteRows.InsertRows(rowscopied - 1)
Application.ScreenUpdating = False
wscopy.Range("A3:I" & CopyLastRow).Copy
wsDest.Range("A" & 3).PasteSpecial Paste:=xlPasteValues
wscopy.Range("K3:L" & CopyLastRow).Copy
wsDest.Range("K" & 3).PasteSpecial Paste:=xlPasteValues
wscopy.Range("N3:V" & CopyLastRow).Copy
wsDest.Range("N" & 3).PasteSpecial Paste:=xlPasteValues
Else
wsDest.Activate
Cells(destlastrow + 1, 1).Select
'In this case there is already data in the master sheet, the number of rows to be copied = the number of rows to be added in the master sheet.
Call InsertDeleteRows.InsertRows(rowscopied)
Application.ScreenUpdating = False
wscopy.Range("A3:I" & CopyLastRow).Copy
wsDest.Range("A" & destlastrow + 1).PasteSpecial Paste:=xlPasteValues  'data to be added to the row below the last row with data
wscopy.Range("K3:L" & CopyLastRow).Copy
wsDest.Range("K" & destlastrow + 1).PasteSpecial Paste:=xlPasteValues  'data to be added to the row below the last row with data
wscopy.Range("N3:V" & CopyLastRow).Copy
wsDest.Range("N" & destlastrow + 1).PasteSpecial Paste:=xlPasteValues  'data to be added to the row below the last row with data
End If




'Close the SCA workbook
wbCopy.Close
Next path
End Sub

Sub InsertRows(Optional RowsInserted As Long = -1)
'insert rows into forecast section of forecast sheet
Application.ScreenUpdating = False
'set row to insert above
Dim target As Range
Set target = Range(ActiveCell.Address)
' work out acceptable range
Dim rws As Integer
Dim endrw As Integer
Dim InsertDeleteArea As Range
Dim frng As Range
Dim frngtl As Range
Set InsertDeleteArea = Range("InsertDeleteArea")
rws = InsertDeleteArea.Rows.Count + 1
endrw = rws - 1
Set frngtl = InsertDeleteArea.Cells(1, 1)
Set frng = Range(frngtl.Offset(1, 0), frngtl.Offset(endrw, InsertDeleteArea.Columns.Count - 1))
' check if target is within acceptable range
If Application.Intersect(target, frng) Is Nothing Then
MsgBox "The row you have selected to insert above is not within the allowable range.  Please reselect and try again", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
Else
If Application.Intersect(target, frng) Is Nothing Then
MsgBox "The row you have selected to insert above is not within the allowable range.  Please reselect and try again", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
End If
End If
'set rows to insert
Dim rng As Long
Dim rng2 As Long
'If RowsInserted = -1 it means the insert button is pressed, then ask the user how many rows they would like to insert. Otherwise the update sub will pass in the number of rows
If RowsInserted = -1 Then
Application.DisplayAlerts = False
On Error Resume Next
rng = InputBox("Enter number of rows required.", "Message from CCR")
On Error GoTo 0
Application.DisplayAlerts = True
Else
rng = RowsInserted
End If
If rng = 0 Then
MsgBox "You didn't specify any rows to insert!", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
End If
rng2 = rng - 1
Call UnprotectSheet
' ShowAllData
Call ShowAllData
'insert rows
Dim targetrow As Integer
Dim firstrow As Integer
targetrow = target.Row + 1
firstrow = frngtl.Row + 2
If targetrow = firstrow Then
frngtl.Offset(1, 0).EntireRow.Copy
Range(target.Offset(0, 0), target.Offset(rng2, 0)).Select
Selection.EntireRow.Insert
Selection.EntireRow.ClearContents
Else
Range(target.Offset(0, 0), target.Offset(rng2, 0)).Select
Selection.EntireRow.Insert
End If
'If RowsInserted = -1 it means the insert button is pressed, then copy the formulas for the newly inserted rows
If RowsInserted = -1 Then
Range("copy_block_1").Resize(rng, 1).Copy
Range("paste_block_1").Resize(rng, 1).PasteSpecial
Range("copy_block_2").Resize(rng, 1).Copy
Range("paste_block_2").Resize(rng, 1).PasteSpecial
Application.CutCopyMode = False
End If
'Select cell A1
Range("A1").Select
Call ProtectSheet
Application.ScreenUpdating = True
End Sub


Sub DeleteRows(Optional arg As String = "delete")
Application.ScreenUpdating = False
'Delete warning. If arg = delete it means the delete button is pressed. Otherwise it means the update sub calls this sub in which case the message box is not displayed.
If arg = "delete" Then
If MsgBox("Deleting the selected rows from the register cannot be undone. You sure?", vbYesNo + vbExclamation, "Message from CCR") = vbNo Then
Exit Sub
End If
End If
' set rows to delete
Dim drng As Range
Dim drngtl As Range
Dim drngbl As Range
Dim drows As Integer
Set drng = Selection
drows = drng.Rows.Count
Set drngtl = Selection.Cells(1, 1)
Set drngbl = Selection.Cells(drows, 1)
' work out acceptable range
Dim rws As Integer
Dim endrw As Integer
Dim InsertDeleteArea As Range
Dim frng As Range
Dim frngtl As Range
Set InsertDeleteArea = Range("InsertDeleteArea")
rws = InsertDeleteArea.Rows.Count
endrw = rws - 2
Set frngtl = InsertDeleteArea.Cells(1, 1)
Set frng = Range(frngtl.Offset(1, 0), frngtl.Offset(endrw, InsertDeleteArea.Columns.Count - 1))
' check if delete range is deleting all forecast rows
If drows = rws - 2 Then
MsgBox "You cannot delete all the rows. Please reselect and try again.", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
End If
' check if delete range is within acceptable range
If Application.Intersect(drngtl, frng) Is Nothing Then
MsgBox "The rows you have selected are not within the area allowed to be deleted.  Please reselect and try again", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
Else
If Application.Intersect(drngbl, frng) Is Nothing Then
MsgBox "The rows you have selected are not within the area allowed to be deleted.  Please reselect and try again", , "Message from CCR"
Application.ScreenUpdating = True
Exit Sub
Else
Call UnprotectSheet
' ShowAllData
Call ShowAllData
' delete row
Selection.EntireRow.Delete
Call ProtectSheet
End If
End If
Application.ScreenUpdating = True
End Sub

Sub ShowAllData()
' Get rid of filters
On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0
End Sub