Insert/Delete Row Code Issue

[klutz]

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.

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...

[Benzadeus]

Change

 If Target.Column = 6 Then

for

 If Target.Column = 6 And Target.Row >= 27 Then

[klutz]

Thank you very much, it works.



The K-