Macro run error in a shared & protected workbook

I have a shared workbook and worksheets Admision and Discharge have all cells locked except for the cells to enter the data in. What I need to do is to clear contents in H:U if B is empty. This has to be a shared workbook and protected.This works great if the workbook isn't shared.

Any help is greatly appreciated

'Sub DeleteEmpty

Sheets("Discharge").Select
ActiveSheet.Unprotect Password:="1234"
Dim i As Integer
With ThisWorkbook.Worksheets("Discharge")
For i = 4 To 34
If .Range("B" & i) = "" Then .Range("H" & i & ":U" & i).ClearContents
Next
End With
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Unfortunately, sharing a workbook locks down all sorts of features. Things like protection cannot be changed while a workbook is shared. This link will shed some light: http://blog.contextures.com/archives...ooks-in-excel/

What I would suggest is to leave the sheet unlocked and then use the worksheet's Change event to test if the change should be allowed.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B")) Is Nothing Then
        'Do your thing here.
    Else
        Application.Undo
    End If
End Sub

Also, please be sure to use CODE tags in your posts. It makes your code much easier to read and copy. See the forum rules for details.