Allow macro to work for a group of cells but not the other cells
On 3 mei, 20:18, "Norman Jones"
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("A1:D20") * *'<<=== 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("A1:D20") * *'<<=== 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
wrote in message
...
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
|