Setting Protection on Workbook to be read only

[bamaisgreat]

Thanks for the veiw.

I have a Workbook named "Master Archive" that contain data from 9 workbooks. This is all done with a macro upon opening each workbook and using a command button to send the data to it. Question is I want everyone to be able to view the Master Archive Workbook in a readonly fashion and the orginal to always remain closed. Reason being is I cant run the macro to archive the data if someone has it open, which then would cause debug issues with the code. Are there settings were I can be the only one to open the workbook and be able to Edit.
Also Everyone has a shortcut to this Master Archive on there Destop.

 

[hippiehacker]

this should do

Private Sub Workbook_Open()
If Environ("username") <> "yourusernamehere" Then 'your username has to go here
 ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub

 

[bamaisgreat]

Im not sure how to incorparate that into what I have

Set rngfil = Range("B4,C4,H4,J4,T4,U4") 'first row of data to be processed
For r = 0 To 18 'row offset variable
EmptyRowCheck = ""
For Each cell In rngfil.Offset(r, 0) 'Concat values of cells in rngfil offset
EmptyRowCheck = EmptyRowCheck & cell
Next cell
If EmptyRowCheck = "" Then GoTo FoundEmptyRow ' if "" empty row of rngfil cells found so stop putting -
For Each cell In rngfil.Offset(r, 0) 'otherwise put - in any empty cell
If cell.Value = vbNullString Then
cell.Value = "-"
End If
Next cell
Next r
FoundEmptyRow: 'stop putting -
' Archive values to ....
Filename = "H:\Burney Table\CUTTING FORMS (Protected by QC)\Archive\Master Archive.xls"
Workbooks.Open (Filename)

HypoAddress = SourcePath & "\" & SourceFile

NR = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
For I = 0 To 18
Sheets("Sheet1").Range("A" & NR + I).Value = ws1.Range("B" & I + 4).Value
'Sheets("Sheet1").Range("B" & NR + I).Value = ws1.Range("B" & I + 4).Value
Sheets("Sheet1").Range("C" & NR + I).Value = ws1.Range("C" & I + 4).Value
Sheets("Sheet1").Range("D" & NR + I).Value = ws1.Range("H" & I + 4).Value
Sheets("Sheet1").Range("E" & NR + I).Value = ws1.Range("J" & I + 4).Value
Sheets("Sheet1").Range("F" & NR + I).Value = ws1.Range("T" & I + 4).Value
Sheets("Sheet1").Range("G" & NR + I).Value = ws1.Range("U" & I + 4).Value
'Sheets("Sheet1").Range("H" & NR + I).Value = ws1.Range("U" & I + 4).Value


HypoSubAddress = "'" & ws1.name & "'" & "!" & ws1.Range("H" & I + 4).Address

If Not ws1.Range("H" & I + 4).Value = "" Then
Sheets("Sheet1").Hyperlinks.Add Anchor:=Sheets("Sheet1").Range("H" & NR + I), Address:= _
HypoAddress, SubAddress:= _
HypoSubAddress, TextToDisplay:= _
"Link To...."
End If


Next I
ActiveWorkbook.Save
ActiveWorkbook.Close

 

[hippiehacker]

my code needs to go into thisworkbook section not in a module

 

[bamaisgreat]

Oh ok by simply doing this and entering in my excel username my pc is the only one that can open this correct ????

 

[bamaisgreat]

Hippiehacker is the username my Excel username or My PC username ?
I tried the Excel User name and would only open in Read Only for me

 

[hippiehacker]

Hippiehacker is the username my Excel username or My PC username ?
I tried the Excel User name and would only open in Read Only for me

environ("username") would return the current logged on Windows Username

whereever you logon with your account you would be able to open it without hassle all others would open it in read only.
But btw why not just normal password protect the workbook for editing and force the user without password to open it read only? this is done without any VBA

 

[bamaisgreat]

How could the code be edited for lets say 3 users ?

Private Sub Workbook_Open()
If Environ("username") <> "yourusernamehere" Then 'your username has to go here
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If
End Sub

 

[hippiehacker]

How could the code be edited for lets say 3 users ?

Private Sub Workbook_Open() 
If Environ("username") <> "username1" or Environ("username") <> "username2" or Environ("username") <> "username3" Then  
ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly
End If 
End Sub

 

[bamaisgreat]

Thanks, do you know of a way for the workbook to be un changeable until Macros are enabled. I have seen that the worksheet can be modified if public users do not enable macros.