Hello,

I am working on a workbook where a group of cells must change with a
macro button which will be triggered by a user. Insert value and
color.
The value is used in a formel in another cell.
If value input is wrong the user can reset the cell with a macro
button.

Problem:
1. First Macro works throughout the worksheet and I only want it to be
able to work in 5 groups of cells
2. Second Macro (reset macro)
The reset macro can delete the formel if this cell is chosen so I need
it to function only in the same groups as the first macro.


The code for insert av value and color

Sub mrkArbeidstid()
'
' mrkArbeidstid Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen

ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
Scenarios:=False

With Selection.Interior
.ColorIndex = 35
.Pattern = xlSolid
End With

Selection.Interior.ColorIndex = 35
Selection.Font.ColorIndex = 35
Selection.FormulaR1C1 = "a"

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

The code for reset

Sub mrkTilbakestill()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen

ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
Scenarios:=False

With Selection.Interior

Selection.ClearContents
Selection.Interior.ColorIndex = xlNone

End With

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True


I am just about learning this so if there's someone who has an answer
for me I would be very gratefull

Eric

Hi Eric,

Try assigning the two following procedures to buttons:
'===========>>
Public Sub mrkArbeidstid()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim Rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set Rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If Rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect
For Each rArea In Rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub

'------------->>
Public Sub mrkTilbakestill()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim Rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set Rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If Rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect
For Each rArea In Rng2.Areas
With rArea
.Interior.ColorIndex = xlNone
.ClearContents
End With
Next rArea

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub
'<<===========



---
Regards.
Norman


<(E-Mail Removed)> wrote in message
news:8930ae02-e40d-4e90-b67b-(E-Mail Removed)...
> Hello,
>
> I am working on a workbook where a group of cells must change with a
> macro button which will be triggered by a user. Insert value and
> color.
> The value is used in a formel in another cell.
> If value input is wrong the user can reset the cell with a macro
> button.
>
> Problem:
> 1. First Macro works throughout the worksheet and I only want it to be
> able to work in 5 groups of cells
> 2. Second Macro (reset macro)
> The reset macro can delete the formel if this cell is chosen so I need
> it to function only in the same groups as the first macro.
>
>
> The code for insert av value and color
>
> Sub mrkArbeidstid()
> '
> ' mrkArbeidstid Makro
> ' Makro registrert 22.01.2008 TPS og EG
> ' Registrerer arbeidstid for maskin og dekksbesetningen
>
> ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
> Scenarios:=False
>
> With Selection.Interior
> .ColorIndex = 35
> .Pattern = xlSolid
> End With
>
> Selection.Interior.ColorIndex = 35
> Selection.Font.ColorIndex = 35
> Selection.FormulaR1C1 = "a"
>
> ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
> Scenarios:=True
>
> The code for reset
>
> Sub mrkTilbakestill()
> '
> ' mrkTilbakestill Makro
> ' Makro registrert 22.01.2008 TPS og EG
> ' Registrerer arbeidstid for maskin og dekksbesetningen
>
> ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
> Scenarios:=False
>
> With Selection.Interior
>
> Selection.ClearContents
> Selection.Interior.ColorIndex = xlNone
>
> End With
>
> ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
> Scenarios:=True
>
>
> I am just about learning this so if there's someone who has an answer
> for me I would be very gratefull
>
> Eric
>
>

On 3 mei, 20:18, "Norman Jones" <normanjo...@wherforartthou.com>
wrote:
> Hi Eric,
>
> Try assigning the two following procedures to buttons:
> '===========>>
> Public Sub mrkArbeidstid()
> '
> ' mrkTilbakestill Makro
> ' Makro registrert 22.01.2008 TPS og EG
> ' Registrerer arbeidstid for maskin og dekksbesetningen
> * * Dim Rng As Range
> * * Dim Rng2 As Range
> * * Dim rArea As Range
>
> * * Set Rng = ActiveSheet.Range("A120") * *'<<=== CHANGE
>
> * * On Error Resume Next
> * * Set Rng2 = Intersect(Selection, Rng)
> * * On Error GoTo 0
>
> * * If Rng2 Is Nothing Then
> * * * * Exit Sub
> * * End If
>
> * * ActiveSheet.Unprotect
> * * For Each rArea In Rng2.Areas
> * * * * With rArea
> * * * * * * .Font.ColorIndex = 35
> * * * * * * .Formula = "a"
> * * * * * * With .Interior
> * * * * * * * * .ColorIndex = 35
> * * * * * * * * .Pattern = xlSolid
> * * * * * * End With
> * * * * End With
> * * Next rArea
>
> * * ActiveSheet.Protect _
> * * * * * * DrawingObjects:=True, _
> * * * * * * Contents:=True, _
> * * * * * * Scenarios:=True
> End Sub
>
> '------------->>
> Public Sub mrkTilbakestill()
> '
> ' mrkTilbakestill Makro
> ' Makro registrert 22.01.2008 TPS og EG
> ' Registrerer arbeidstid for maskin og dekksbesetningen
> * * Dim Rng As Range
> * * Dim Rng2 As Range
> * * Dim rArea As Range
>
> * * Set Rng = ActiveSheet.Range("A120") * *'<<=== CHANGE
>
> * * On Error Resume Next
> * * Set Rng2 = Intersect(Selection, Rng)
> * * On Error GoTo 0
>
> * * If Rng2 Is Nothing Then
> * * * * Exit Sub
> * * End If
>
> * * ActiveSheet.Unprotect
> * * For Each rArea In Rng2.Areas
> * * * * With rArea
> * * * * * * .Interior.ColorIndex = xlNone
> * * * * * * .ClearContents
> * * * * End With
> * * Next rArea
>
> * * ActiveSheet.Protect _
> * * * * * * DrawingObjects:=True, _
> * * * * * * Contents:=True, _
> * * * * * * Scenarios:=True
> End Sub
> '<<===========
>
> ---
> Regards.
> Norman
>
> <nedno...@yahoo.no> wrote in message
>
> news:8930ae02-e40d-4e90-b67b-(E-Mail Removed)...
>
>
>
> > Hello,
>
> > I am working on a workbook where a group of cells must change with a
> > macro button which will be triggered by a user. Insert value and
> > color.
> > The value is used in a formel in another cell.
> > If value input is wrong the user can reset the cell with a macro
> > button.
>
> > Problem:
> > 1. First Macro works throughout the worksheet and I only want it to be
> > able to work in 5 groups of cells
> > 2. Second Macro (reset macro)
> > The reset macro can delete the formel if this cell is chosen so I need
> > it to function only in the same groups as the first macro.
>
> > The code for insert av value and color
>
> > Sub mrkArbeidstid()
> > '
> > ' mrkArbeidstid Makro
> > ' Makro registrert 22.01.2008 TPS og EG
> > ' Registrerer arbeidstid for maskin og dekksbesetningen
>
> > * *ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
> > Scenarios:=False
>
> > * *With Selection.Interior
> > * * * *.ColorIndex = 35
> > * * * *.Pattern = xlSolid
> > * *End With
>
> > * *Selection.Interior.ColorIndex = 35
> > * *Selection.Font.ColorIndex = 35
> > * *Selection.FormulaR1C1 = "a"
>
> > * *ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
> > Scenarios:=True
>
> > The code for reset
>
> > Sub mrkTilbakestill()
> > '
> > ' mrkTilbakestill Makro
> > ' Makro registrert 22.01.2008 TPS og EG
> > ' Registrerer arbeidstid for maskin og dekksbesetningen
>
> > * *ActiveSheet.Protect DrawingObjects:=False, Contents:=False,
> > Scenarios:=False
>
> > * *With Selection.Interior
>
> > * * * *Selection.ClearContents
> > * * * *Selection.Interior.ColorIndex = xlNone
>
> > * *End With
>
> > * *ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
> > Scenarios:=True
>
> > I am just about learning this so if there's someone who has an answer
> > for me I would be very gratefull
>
> > Eric- Tekst uit oorspronkelijk bericht niet weergeven -
>
> - Tekst uit oorspronkelijk bericht weergeven -

Thank you for quick and usefull help.
It works fantastic.

There is only one thing that is missing now and that is to protect the
sheet with a password.
I thought that that would be easy since I saw several examples in this
discusion group.
But as always, nothing is as easy as it looks.
I tried the following but get an error message for the
ActiveSheet.Protect part.
Can you help me out with this?

ActiveSheet.Unprotect Password:="test"
For Each rArea In Rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea


ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
Password:="test"

Thanks

Eric

Hello

I did as you suggested and it work good.
The problem now is to prtect it with a password.
I tried a view things which I read in this discussion group but I
can't get it to work.
I manage to unprotect the password but not to protect it again.
I protected the sheet with password as normal in excell
The macro unprotects but doesn't protect with password afterwards.
Can you help out,.

Eric

code

ActiveSheet.Unprotect Password:="test"
For Each rArea In Rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea


ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

ActiveSheet.Protect Password:="test"

Hi Eric,

At the top of a standard module, brfore
any other code try the following minor
modificarion:

'===========>>
Option Explicit
Const PWORD As String = "Pluto" '<<=== CHANGE

'------------->>
Public Sub mrkArbeidstid()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect Password:=PWORD
For Each rArea In rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea

ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub

'------------->>
Public Sub mrkTilbakestill()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect
For Each rArea In rng2.Areas
With rArea
.Interior.ColorIndex = xlNone
.ClearContents
End With
Next rArea

ActiveSheet.Protect _
Password:=PWORD, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub
'<<===========


---
Regards.
Norman


<(E-Mail Removed)> wrote in message
news:a86be2d9-91c8-406f-8f8d-(E-Mail Removed)...
On 3 mei, 20:18, "Norman Jones" <normanjo...@wherforartthou.com>

Thank you for quick and usefull help.
It works fantastic.

There is only one thing that is missing now and that is to protect the
sheet with a password.
I thought that that would be easy since I saw several examples in this
discusion group.
But as always, nothing is as easy as it looks.
I tried the following but get an error message for the
ActiveSheet.Protect part.
Can you help me out with this?

ActiveSheet.Unprotect Password:="test"
For Each rArea In Rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea


ActiveSheet.Protect _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
Password:="test"

Thanks

Eric

Hi Eric,

Please replce the previous code with:

'===========>>
Option Explicit
Const PWORD As String = "Pluto"

'------------->>
Public Sub mrkArbeidstid()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect _
Password:=PWORD
For Each rArea In rng2.Areas
With rArea
.Font.ColorIndex = 35
.Formula = "a"
With .Interior
.ColorIndex = 35
.Pattern = xlSolid
End With
End With
Next rArea

ActiveSheet.Protect _
Password:=PWORD, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub

'------------->>
Public Sub mrkTilbakestill()
'
' mrkTilbakestill Makro
' Makro registrert 22.01.2008 TPS og EG
' Registrerer arbeidstid for maskin og dekksbesetningen
Dim Rng As Range
Dim rng2 As Range
Dim rArea As Range

Set Rng = ActiveSheet.Range("A120") '<<=== CHANGE

On Error Resume Next
Set rng2 = Intersect(Selection, Rng)
On Error GoTo 0

If rng2 Is Nothing Then
Exit Sub
End If

ActiveSheet.Unprotect Password:=PWORD
For Each rArea In rng2.Areas
With rArea
.Interior.ColorIndex = xlNone
.ClearContents
End With
Next rArea

ActiveSheet.Protect _
Password:=PWORD, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True
End Sub
'<<===========


---
Regards.
Norman

Hi Eric,

See the password reply in the main
thread.


---
Regards.
Norman


<(E-Mail Removed)> wrote in message
news:23f0ab8d-0c72-4608-adcc-(E-Mail Removed)...
>
> Hello
>
> I did as you suggested and it work good.
> The problem now is to prtect it with a password.
> I tried a view things which I read in this discussion group but I
> can't get it to work.
> I manage to unprotect the password but not to protect it again.
> I protected the sheet with password as normal in excell
> The macro unprotects but doesn't protect with password afterwards.
> Can you help out,.
>
> Eric
>
> code
>
> ActiveSheet.Unprotect Password:="test"
> For Each rArea In Rng2.Areas
> With rArea
> .Font.ColorIndex = 35
> .Formula = "a"
> With .Interior
> .ColorIndex = 35
> .Pattern = xlSolid
> End With
> End With
> Next rArea
>
>
> ActiveSheet.Protect _
> DrawingObjects:=True, _
> Contents:=True, _
> Scenarios:=True
>
> ActiveSheet.Protect Password:="test"
>

Thanks Norman

It works beautyfull now.
So much you can do with just a bit of code.