Assign and clear value to unlocked cells in a protected sheet

[Ram B]

I want to create two buttons, one that will give the unlocked cells in a
range H12:H400 the text "Gray" and the other will clear the contents. Any
help will be appriciated.

 

[Dick Kusleika]

I want to create two buttons, one that will give the unlocked cells in a
range H12:H400 the text "Gray" and the other will clear the contents. Any
help will be appriciated.

Sub MarkGrey()

Dim rCell As Range

For Each rCell In Sheet1.UsedRange
If Not rCell.Locked Then
rCell.Value = "Gray"
'rcell.ClearContents
End If
Next rCell

End Sub

Make a new sub and change the line to clearcontents for the button to clear.

 

[Ram B]

Thanks - Although this works on the entire sheet, How can get this to a
specific range say range I12:I384, I would like to leave the rest of the
sheet untouched. What I am trying to do is assign specific text to a specific
cllumn by creating a button on the top of the column. I tried this but it
doesnot work

Sub MarkGrey()
Range("I12:I384").Select
Dim rCell As Range

For Each rCell In Worksheets("Passive Safety").UsedRange
If Not rCell.Locked Then
rCell.Value = "Gray"
'rcell.ClearContents
End If
Next rCell

End Sub

 

[Gord Dibben]

Sub MarkGrey()

Dim rCell As Range
Dim rng As Range
Set rng = Worksheets("Passive Safety").Range("I12:I384")
For Each rCell In rng
If Not rCell.Locked Then
rCell.Value = "Gray"
'rcell.ClearContents
End If
Next rCell

End Sub


Gord Dibben MS Excel MVP

 

[Ram B]

Thanks guys, It works BUT


It goes at 2 cells a second or in other words it take approx 3 minutes to go
300+ cells. Ansy suggestions as to how I can speed it up?

 

[Dave Peterson]

Any chance you have worksheet_change events that fire with each change?

If yes, you could tell excel to stop looking for those changes while your code
does the work.

Sub MarkGrey()

Dim rCell As Range
Dim rng As Range

Set rng = Worksheets("Passive Safety").Range("I12:I384")

application.enableevents = false
For Each rCell In rng
If Not rCell.Locked Then
rCell.Value = "Gray"
'rcell.ClearContents
End If
Next rCell
application.enableevents = true

End Sub