Code that errase

[RAM]

Hi guys,

I could need a code that errase all unlocked cells. The code must work in grouped sheets.

Thanks,

RAM

 

[DonkeyOte]

Without installing some customised add-ins I don't think you can do this without iterating through the array of sheets and used cells and checking protected status of each.... ie no way of creating an array of protected cells using built in libraries.

Sub x()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
For Each ws In Worksheets(Array("Sheet1", "Sheet2"))
    With ws
        Set rng = .UsedRange
        For Each cell In rng
            Select Case cell.Locked
                Case False
                    cell.Value = ""
            End Select
        Next cell
    End With
Next ws
End Sub

 

[DonkeyOte]

sorry, just realised you probably won't know the array until run-time in which case instead of

For Each ws In Worksheets(Array("Sheet1", "Sheet2"))

use

For Each ws In ActiveWindow.SelectedSheets

 

[RAM]

Thanks a bundle,

There is only going to be one problem. I'm using this code to name the sheet, i.e the sheet name can vary:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Target.Address <> "$AD$3" Then Exit Sub
ActiveSheet.Name = Range("AD3").Text
End Sub

Your code must not run a certain, named,set of sheets (even though it would be great, it doesn't work this time), but it must run when I group sheets (just a added infomation). It must run on the selected (active) sheets, NOT on any others.

Thanks,
RAM

 

[RAM]

Your correction made it. Thanks. Seems to work as a charm.

RAM

 

[RAM]

Just to avoid any errors, let's add a msg box: "Are you sure you want to remove all data?" YES-NO

RAM

 

[DonkeyOte]

Sub x()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
If MsgBox("Delete All Data?",vbYesNo,"Run Clear?") = vbNo Then Exit Sub
For Each ws In ActiveWindow.SelectedSheets
    With ws
        Set rng = .UsedRange
        For Each cell In rng
            Select Case cell.Locked
                Case False
                    cell.Value = ""
            End Select
        Next cell
    End With
Next ws
End Sub

 

[RAM]

Thanks, Works great.

RAM