ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   allow change font while password pretected. (https://www.excelbanter.com/excel-discussion-misc-queries/256935-allow-change-font-while-password-pretected.html)

Chris
allow change font while password pretected.
 
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
allow change font while password pretected.
 
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

Mike H
allow change font while password pretected.
 
Chris,

I'm not sure I understand but you can use a password with VB

ActiveSheet.Unprotect password:="MyPass"

and likewise

ActiveSheet.protect password:="MyPass"
--
Mike

When competing hypotheses are otherwise equal, adopt the hypothesis that
introduces the fewest assumptions while still sufficiently answering the
question.


"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

Chris
allow change font while password pretected.
 
Thanks for that Dave.
I had been trying to change the colours of cell inputs and make bold. We
make the new items Red Bold and black bold for anything one day old then
black standard from then on. So this worked perfectly.
I had tryed to put it in myself the same but I was entering the
Activesheet.Protect_ password on the same line.

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
.

Chris
allow change font while password pretected.
 
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
allow change font while password pretected.
 
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

Chris
allow change font while password pretected.
 
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
.


All times are GMT +1. The time now is 02:20 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com