Environ and EntireRow.Lock to unlock rows owned by Environ User upon sheet select and lock others.

[arisrune]

Hello Excel gurus,

Can there be a combination of code that will:

1. Get Environ("username") in memory
2. Paste said username into an edited row cell at, say, A5 when any in B5:X5 is edited, down to each potential row 1000+
3. Check current Environ username against all rows with Pasted username for match
4. If match, unlock rows that match. If no match, lock rows that don't . (keep blank rows unlocked as well)
5. Result = a Reversi situation upon sheet select(or open file) where only current user can edit his own lines or add new lines.

Challenges for me:

• Havent seen the type of operation (3-5) in forums though I see some of the pieces for it.
• most implementations for locking a row require cell editing to trigger, would need an event like upon Workbook_open or activation of sheet to properly enforce (3-5) consistently.

I have been looking through dozens of posts. (2 examples below). I'm still beginning in VBA, so this has been quite the experience trying to bridge the gap.

https://www.mrexcel.com/forum/excel-questions/238435-unprotect-cell-based-username-match.html
Excel VBA - Insert Username ONLY when cell is changed - Stack Overflow

 

[mse330]

Welcome to the forums arisrune

With information you've provided & based on my understanding, you can try the below code & adjust it according to your needs or let us know more details & we'll gladly help you out further

This will basically check the UserName on file opening & lock/unlock cells accordingly

Private Sub Workbook_Open()

Dim lRow As Long, x As Long
Dim User As String

'Unprotecting & unlocking all cells in the active sheet
With ActiveSheet
    .Unprotect
    .Cells.Locked = False
End With

User = UCase(Environ("UserName"))
lRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

'Check the User Names assuming they're in column A & loop & locked the cells in range A:X if the user <> Environ
For x = 5 To lRow
    If UCase(Cells(x, 1).Value) <> User Then
        Range(Cells(x, 1), Cells(x, 23)).Locked = True
    End If
Next x

'Protect sheet again with allowing insert rows
ActiveSheet.Protect AllowInsertingRows:=True

End Sub

 

[arisrune]

Thanks Mse330,

It worked really well and was a great lesson in looping.


I also figured out how to hard stamp the Environ("username") with cell entry to make it complete for others that would like to implement this fully.
It's not pretty, but it works. So if anyone wants to clean it up...please post your version.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("C4:C1003")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then
Call Paste_Getname
End If
End Sub
Sub Paste_Getname()
'Takes ActiveCell and offset to work on any row selected without specifics. Kept in check by the setKeycells range.
'
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = UCase(Environ("UserName"))
ActiveCell.Copy
ActiveCell.PasteSpecial xlPasteValues
'Moves active cell to next column after operation
ActiveCell.Offset(0, 2).Select
End Sub

 

[mse330]

You are welcome ... Regarding your second code, I think you should almost always avoid select/copy/paste in VBA as it makes the operation slower & the code lengthier without any need. I think the below can achieved what you need in 1 line instead of calling another sub & having multiple lines of code

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Set KeyCells = Range("C4:C1003")
    
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
    ActiveCell.Offset(0, -1).Value = UCase(Environ("UserName"))
End If

End Sub

 

[arisrune]

That works great too. Thanks!

 

[mse330]

You are most welcome