Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

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 DeleteRowsSASdeck()
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

--

Dave Peterson
.

Option Explicit
Sub InsertRowsSASDeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to insert", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Insert
.Cells(myRow, "D").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*b" & myRow
.Cells(myRow, "I").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*e" & myRow
.Cells(myRow, "J").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*f" & myRow
.Cells(myRow, "K").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*g" & myRow

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

End With

End Sub
Sub DeleteRowsSASdeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to delete", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Delete
.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With

End Sub



Chris wrote:

Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

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 DeleteRowsSASdeck()
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

--

Dave Peterson
.


--

Dave Peterson

Thanks again Dave

Perfect.

"Dave Peterson" wrote:

Option Explicit
Sub InsertRowsSASDeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to insert", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Insert
.Cells(myRow, "D").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*b" & myRow
.Cells(myRow, "I").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*e" & myRow
.Cells(myRow, "J").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*f" & myRow
.Cells(myRow, "K").Resize(HowManyRows, 1).Formula _
= "=a" & myRow & "*g" & myRow

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

End With

End Sub
Sub DeleteRowsSASdeck()

Dim HowManyRows As Long
Dim myRow As Long
Dim myCell As Range

Set myCell = ActiveCell 'single cell
myRow = myCell.Row

If myCell.Interior.ColorIndex < 36 Then
Exit Sub
End If

HowManyRows = CLng(Application.InputBox(Prompt:="how many rows to delete", _
Type:=1))

If HowManyRows < 1 Then
Exit Sub
End If

'some sort of sanity check to stop typos
If HowManyRows 50 Then
Exit Sub
End If

With ActiveSheet
.Unprotect
.Cells(myRow, "A").Resize(HowManyRows, 1).EntireRow.Delete
.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
AllowFormattingCells:=True, _
AllowFormattingColumns:=True, _
AllowFormattingRows:=True, _
AllowInsertingRows:=False, _
AllowInsertingHyperlinks:=True, _
AllowSorting:=True, _
AllowFiltering:=True, _
AllowUsingPivotTables:=True
End With

End Sub



Chris wrote:

Hi
In the code below, section for amount of rows I would like to have a choise
of how meny rows to insert or delete each time, I have seen part of a code
that gives you this choise but I cant get it to do that. can You help.
Regards
Chris

"Dave Peterson" wrote:

First, you didn't say what you wanted to bold/change font color.

I'd record a macro to get the cells correct and the font color, too.

But you can use:
ActiveSheet.Unprotect password:="YourPasswordHere"
....your code
ActiveSheet.Protect _
password:="YourPasswordHere", _
DrawingObjects:=True, _



Chris wrote:

Hi all
I have this sub below that I use, It works very well apart from one small
thing. I would like to have a password in it. Also I need to be able to
change the font colour and make bold etc. I have tryed adding it to the sub
but it wont work, as the sub is now it works but users can go to the
protection in tools and unprotect. If I add a password to the sheet I cant
use the macro. Please help

Regards
Chris

Sub InsertRowsSASDeck()

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 DeleteRowsSASdeck()
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

--

Dave Peterson
.


--

Dave Peterson
.