Adding or removing rows

[Chris]

Hi all.
I have got a macro that I use for adding and deleting rows while sheet is
protected (Gord Dibben helped me with, and is working well). I do have one
thing that may be a problem and that is there are certain rows I dont want to
be changed. These are the last row of each section and have the sub totals.
The problem is that if one of these rows get deleted by misstake it will
upset the final total at end of the sheet.
Is there anyway to stop these from being upset and protected.

Regards
Chris

 

[Jim Thomlinson]

Post your code...

 

[Chris]

Hi Jim
I have sections of about 10 rows that I can add or remove rows. These have
formulas in witch this code comands. Then on the next row below I have totals
from the rows above with more formulas, I dont want to be able to add or
remove if row is selected by mistake.
Regards
Chris


Sub testme()
Call InsertRowsAndFillFormulas
End Sub
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)

Dim myCell As Range

If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", _
Title:="Add Rows", _
Default:=1, Type:=1)

If vRows = False Then
Exit Sub
End If
End If

ActiveSheet.Unprotect

Set myCell = ActiveCell

myCell.Offset(1).Resize(vRows).EntireRow.Insert

myCell.EntireRow.AutoFill _
Destination:=myCell.Resize(vRows + 1).EntireRow, _
Type:=xlFillDefault

On Error Resume Next
myCell.Offset(1, 0).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
On Error GoTo 0

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

 

[Chris]

Hi Jim
I have sections of about 10 rows that I can add or remove rows. These have
formulas in witch this code comands. Then on the next row below I have totals
from the rows above with more formulas, I dont want to be able to add or
remove if row is selected by mistake. this is the one I use for inserting rows and I have another for deleting rows.
Regards
Chris


Sub testme()
Call InsertRowsAndFillFormulas
End Sub
Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)

Dim myCell As Range

If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", _
Title:="Add Rows", _
Default:=1, Type:=1)

If vRows = False Then
Exit Sub
End If
End If

ActiveSheet.Unprotect

Set myCell = ActiveCell

myCell.Offset(1).Resize(vRows).EntireRow.Insert

myCell.EntireRow.AutoFill _
Destination:=myCell.Resize(vRows + 1).EntireRow, _
Type:=xlFillDefault

On Error Resume Next
myCell.Offset(1, 0).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
On Error GoTo 0

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

 

[Jim Thomlinson]

Sorry about taking so long. Try this...

Sub testme()
Call InsertRowsAndFillFormulas
End Sub

Sub InsertRowsAndFillFormulas(Optional vRows As Long = 0)

Dim myCell As Range

Set myCell = ActiveCell

If InStr(1, Cells(myCell.Row, "A").Value, "Total") > 0 Then
MsgBox "Total Line"
Exit Sub
End If
If vRows = 0 Then
vRows = Application.InputBox(prompt:= _
"How many rows do you want to add?", _
Title:="Add Rows", _
Default:=1, Type:=1)

If vRows = False Then
Exit Sub
End If
End If

ActiveSheet.Unprotect


myCell.Offset(1).Resize(vRows).EntireRow.Insert

myCell.EntireRow.AutoFill _
Destination:=myCell.Resize(vRows + 1).EntireRow, _
Type:=xlFillDefault

On Error Resume Next
myCell.Offset(1, 0).Resize(vRows).EntireRow. _
SpecialCells(xlConstants).ClearContents
On Error GoTo 0

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=True, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub

 

[Chris]

Hi Jim
I coppied the code and tried it but it didn't help. Can I select a group of
rows I could work with and leave out the ones I need left as is. Eg select
rows 1 to 10 then 12 to 20 ,22 to 30 etc.
Regards
Chris

 

[Don Guillett]

If desired, send your file to my address below. I will only look if:
1. You send a copy of this message on an inserted sheet
2. You give me the newsgroup and the subject line
3. You send a clear explanation of what you want
4. You send before/after examples and expected results.

 

[Gord Dibben]

Tough loss for those 'horns'

I was pulling for Gilbert to come through.


Gord

 

[Don Guillett]

Thanks Gord,
I blame it on the system that forces Brown to play McCoy in previous games
that Texas has clearly won to get "style points" at the expense of players
getting experience. I mentioned this to coach Royal a couple of months ago
at a party and he agreed.
When I was driving SCCA open wheel race cars (Formula Ford) there was NO
substitute for track time. I would even run Regional races just to get track
time.
I truly believe that we would have won except for McCoy's pinched nerve.

 

[Gord Dibben]

Know what you mean.

I had the same problems when I was managing Midget hockey rep teams for a
few years.

I had to deal with coaches who were concerned about amassing overwhelming
wins in the Zones to ensure we would reach the Provincial Finals where they
could "get noticed" by the Junior scouts.

Was a constant struggle to get playing time for backup goalies and some of
the lesser skilled players.

Get a couple of guys hurt or just worn down and not much gas left in the
tank.


Gord

 

[Don Guillett]

We live in Austin (Lakeway area by the Lake Travis dam) in the Lake Travis
High School district where Gilbert is a hero... With him, that HS won the
State Football championship the last TWO years. Texas HS football is king.
He was named the best HS player in Texas last year. So, we expect good
things next year.

 

[Chris]

Hi Don
Thanks alot, Code is working well.

Best Regards
Chris

 

[Don Guillett]

For the archives
Only insert\delete rows if unprotected yellow area selected

Option Explicit
Sub InsertRowsSAS()
Dim ar As Long
If Selection.Interior.ColorIndex <> 36 _
Or Selection.Count > 1 Then Exit Sub

ActiveSheet.Unprotect
ar = ActiveCell.Row
Selection.EntireRow.Insert
Cells(ar, "d").Formula = "=a" & ar & "*b" & ar & ""
Cells(ar, "i").Formula = "=a" & ar & "*e" & ar & ""
Cells(ar, "j").Formula = "=a" & ar & "*f" & ar & ""
Cells(ar, "k").Formula = "=a" & ar & "*g" & ar & ""

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True

End Sub
Sub DeleteRowsSAS()
If Selection.Interior.ColorIndex <> 36 Then Exit Sub
ActiveSheet.Unprotect

Selection.EntireRow.Delete

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End Sub