Allow macro to work for a group of cells but not the other cells
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("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 _
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("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 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
|