userinterfaceonly=True fails with this code!

[michael.beckinsale]

Hi All,

I have a workbook in which all the sheets are protected with the code
posted below. Other code within the workbook works with the the sheets
protected but the second code snippet below fails at the copy /paste
lines. Can anybody point me in the right direction as to what is
causing this ?

I have completely unprotected all the sheets then re-protected them
with the code, re-saved the workbook etc shown but nothing l have
tried cures this problem and it is driving me insane. I have recently
added 'Option Private Module' to each of the code modules to prevent
users seeing the code from within Excel but removing same does not
cure the problem.

All contributions gratefully received.

Sub MyProtect()

Dim Filename As String

Filename = ActiveWorkbook.Name

Application.ScreenUpdating = False

For Each Sht1 In Workbooks(Filename).Worksheets
Sht1.DisplayAutomaticPageBreaks = False
Sht1.Protect ("PWD"), userinterfaceonly:=True
Sht1.EnableOutlining = True
Next Sht1

End Sub

Sub ImportedSwitchDatabase_To_SwitchDatabase()

Dim CheckArray As Range
Dim FindWhat As String
Dim SourceRow As Long
Dim TargetRow As Long
Dim SourceSheet As Worksheet
Dim TargetSheet_1 As Worksheet
Dim TargetSheet_2 As Worksheet
Dim CheckSheet As Worksheet

'Change these 4 lines to the relevant sheets

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set SourceSheet = Sheets("Imported_Switch_Database")
Set CheckSheet = Sheets("Switch_Database")
Set TargetSheet_1 = Sheets("Switch_Database")
Set TargetSheet_2 = Sheets("Ignored_Switch_Database")

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

SourceSheet.Activate
For Each sCell In SourceSheet.Range("D7" & LR)
Set CheckArray = CheckSheet.Range("D7" & LRo(, CheckSheet,
"B"))
FindWhat = sCell.Value
SourceRow = sCell.Row
If CheckArray.Find(FindWhat, lookat:=xlWhole,
searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=True) Is
Nothing Then
TargetRow = LRo(, TargetSheet_1, "B") + 1
If TargetRow > 6 Then
SourceSheet.Range("B" & SourceRow & ":CL" &
SourceRow).Copy TargetSheet_1.Range("B" & TargetRow)
End If
Else
TargetRow = LRo(, TargetSheet_2, "B") + 1
If TargetRow > 6 Then
SourceSheet.Range("B" & SourceRow & ":CL" &
SourceRow).Copy TargetSheet_2.Range("B" & TargetRow)
End If
End If
Next

'Tidy up
SourceSheet.Activate
With ActiveSheet.Range("B7:CL" & LR)
.RowHeight = 57.5
.VerticalAlignment = xlTop
End With
TargetSheet_1.Activate
With ActiveSheet.Range("B7:CL" & LR)
.RowHeight = 57.5
.VerticalAlignment = xlTop
End With
TargetSheet_2.Activate
With ActiveSheet.Range("B7:CL" & LR)
.RowHeight = 57.5
.VerticalAlignment = xlTop
End With

End Sub

Note: LRo is a UDF to find the last row on a specific sheet, col, etc
and returns the correct result

Regards

Michael

 

[michael.beckinsale]

Hi All,

Problem solved, but not sure l understand why:

Dim SourceSheet As Worksheet

but

Set SourceSheet = Sheets("MySheet")

should be

Set SourceSheet = Worksheets("MySheet")

Regards

Michael