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

arisrune

New Member
Joined
Aug 12, 2017
Messages
4
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

Active Member
Joined
Oct 18, 2007
Messages
449
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

Code:
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

New Member
Joined
Aug 12, 2017
Messages
4
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.

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
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

Active Member
Joined
Oct 18, 2007
Messages
449
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

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
 
Last edited:

Forum statistics

Threads
1,081,802
Messages
5,361,388
Members
400,628
Latest member
ganeshkhatri

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top