Good evening to the team. Please for your help.
I have the attached file with vba that with each change made in specific cells, the name of the respective user is inserted into a cell.
I want without changing the first cell, with the next processing of the cell in the same line, the name of the second user is entered in the second cell if cell I8 is greater than 1.
Attachment 31209
Attachment 31208
Thanks in advance
Spiros
(Sorry for two files. I don't know how to delete the first file.)
Spiros, you will find it much easier to attach your files by clicking on Go Advanced, Manage Attachments, Choose files, Upload and post your attachments.
Have a try with these changes to your macro:Code:Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("C:E")) Is Nothing Then
'ActiveSheet.Unprotect "mypass"
Application.EnableEvents = False
For Each cell In Intersect(Target, Range("C:E"))
If cell.Value <> "" Then
Cells(cell.Row, cell.Column * 2).Value = Now()
Cells(cell.Row, cell.Column * 2 + 1).Value = Environ$("UserName")
Else
Range(Cells(cell.Row, cell.Column * 2), Cells(cell.Row, cell.Column * 2 + 1)).ClearContents
End If
Columns(cell.Column * 2).AutoFit
Columns(cell.Column * 2 + 1).AutoFit
Next cell
Application.EnableEvents = True
'ActiveSheet.Protect "mypass"
End If
End Sub
Good morning.
Thanks for the help, but it's not correct.
It needs to count the cell "I8" if it is greater than 1, so that with the second change that will be made in the cell "E8", then it will put the user's name in the cell "H8".
The one with the change I make from "C8 "E8", it then writes to the plus 2 cells.
It also has not only the code workbook, but also every sheet in my own file.
I can't put the original excel file, because it is close to 4mb. Even though I compress it to a zip that the page accepts, it still comes to 1,600mb. There is also 7zip and winrar, which download it under 1mb, but the forum does not accept them.
I tried something like this and worked.
If you have a better solution please.
Thank you.
Code:Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim cell As Range
If Not Intersect(Target, Range("C:E")) Is Nothing Then
'ActiveSheet.Unprotect "mypass"
For Each cell In Intersect(Target, Range("C:E"))
Columns(6).AutoFit
Columns(7).AutoFit
If Cells(cell.Row, "I").Value > 1 Then
If cell.Value <> "" Then
Cells(cell.Row, "F").Value = Now()
Cells(cell.Row, "H").Value = Environ$("UserName")
Else
Cells(cell.Row, "F").ClearContents
Cells(cell.Row, "H").ClearContents
End If
Else
If cell.Value <> "" Then
Cells(cell.Row, "F").Value = Now()
Cells(cell.Row, "G").Value = Environ$("UserName")
Else
Cells(cell.Row, "F").ClearContents
Cells(cell.Row, "G").ClearContents
End If
End If
Next cell
'ActiveSheet.Protect "mypass"
End If
End Sub
Sorry, yes in fact, I forgot about cells in column "I" if greater that 1 but it's because I don't really understand what you are up to. I understood you needed a separate timestamp for each column "C" to "E" but forgot about column "I".
So let me know if now I'm right; you want to add/update timestamp+username in cells "F" and "G" every time (or is it only the first time ?) you insert/change data in columns "C", "D", "E" and then only if column "E" is updated and column "I" is greater than 1 add username to column "H".
Hi rollis13.
cell "G" it's only the first time.
cell "F" every time.
The second time (thats why cell in column "I") if greater 1 then stop update cell "G" and add the name in cell "H", with the new Timestamp in the same cell "F".
Then use this new version:Code:Option Explicit
Public secondE As Boolean
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.CountLarge > 1 Or Intersect(Target, Range("E:E")) Is Nothing Then Exit Sub
If Target.Value = vbNullString Then
secondE = False
Else
secondE = True
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.CountLarge > 1 Then Exit Sub
If Not Intersect(Target, Range("C:E")) Is Nothing Then
'ActiveSheet.Unprotect "mypass"
Application.EnableEvents = False
If Target.Value <> "" Then
Cells(Target.Row, "F").Value = Now()
If Target.Column <> 5 Then
Cells(Target.Row, "G").Value = Environ$("UserName")
Else
If secondE = True And Cells(Target.Row, "I").Value > 1 Then
Cells(Target.Row, "H").Value = Environ$("UserName")
Else
Cells(Target.Row, "G").Value = Environ$("UserName")
End If
End If
Else
If Target.Column <> 5 Then
Range(Cells(Target.Row, "F"), Cells(Target.Row, "G")).ClearContents
Else
Range("H" & Target.Row).ClearContents
End If
End If
Columns("F:H").EntireColumn.AutoFit
Application.EnableEvents = True
'ActiveSheet.Protect "mypass"
End If
End Sub
Hello my friend.
Thank you very much for your help and I really appreciate it.
Before you could send me your new effort, I made several changes and additions.
I made some temporary deletions of sheets to make the file smaller so you can see it.
I added a new sheet, where I want your help (Usernames). I want from the green and red sheets to record the cell "A/A" (cell A8) and as you will see and do a test on a sheet of "Timestamp" and "ΕΚΔΟΤΗΣ (username)". The problem I have and I can't fix it is that in the code it is defined that the recording is done according to the line of each sheet.
So if I go to another sheet and make a record, then it will go on top of the other and not below.
In other words, I want the green and red sheets (and there are many more) to record the "A/Α" and the "Timestamp" and "ΕΚΔΟΤΗΣ 1,2,3,...".