Insert/Delete Row Code Issue
Hello Friends,
i have the following code the allows me to insert or delete rows in column F.
I have a problem thought, the rows I insert or delete will be in column F starting from row 27 and and down. So, for example, in row 27 to row 30 I have a set of data and row 32 to row 35 I have another set of data. I want to add 2 rows starting from Row 27, the code adds them perfectly, the problem I have is that from row 5 to row 20 on Column F i have numerical data in those cells and when i change that data to a higher number it starts to add rows from that point, if I add a lower number than it deletes rows.
How can I make the code only add rows or delte rows from column F row 27 and on but not the rows lower than that.
Code:
Public Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long
Dim cell As Range
Dim endRow As Long
Dim startRow As Long
Dim requiredRows As Long
Dim exisistingRows As Long
Me.Unprotect Password:="pwd"
'Single cell only, please
If Target.Columns.Count > 1 Then Exit Sub
'//Check if Col 'F'
If Target.Column = 6 Then
If Target.Offset(0, -1) <> "" Then
requiredRows = Target
'Don't delete first FOUR rows to not lose important formulas
If requiredRows < 5 Then
requiredRows = 5
End If
startRow = Target.row
'count light blue cells to determine exisisting rows number
For r = startRow To startRow + 300
If Cells(r, "E").Interior.ColorIndex <> 20 Then
endRow = r - 1
Exit For
End If
Next r
exisistingRows = endRow - startRow + 1
Application.EnableEvents = False
If requiredRows > exisistingRows Then
'add rows
For r = exisistingRows To requiredRows - 1
Rows(startRow + r).Insert
Rows(startRow + r - 1).Copy Range("a" & startRow + r)
Range("H" & startRow + r & ":t" & startRow + r).ClearContents
Next r
MsgBox "You now have " & targetRow + r & " rows for Insured Location Entry !", vbOKOnly
ElseIf requiredRows < exisistingRows Then
'delete rows
Rows(startRow + requiredRows & ":" & startRow + exisistingRows - 1).Delete
MsgBox "You have now deleted " & exisistingRows - requiredRows & " additional rows!", vbOKOnly
End If
Application.EnableEvents = True
Me.Protect Password:="pwd"
End If
'//Else check if in Range, Column 'D'
ElseIf Not Intersect(Target, Range("d24:d290")) Is Nothing Then
For Each cell In Target
If cell.Value <> "" Then
MakeChange cell.Offset(, 3)
Else
cell.Interior.ColorIndex = 20
End If
Next cell
End If
End Sub
Thanks...:doh:
