klutz

07-30-2009, 11:59 AM

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

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