ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Log when cells are copied (https://www.excelbanter.com/excel-programming/366316-log-when-cells-copied.html)

Sharon

Log when cells are copied
 
Hi
I have had some brilliant answers here before so I am hoping that someone
might have a suggestion for this problem. I need to trap and log a user name
and probably date whenever the user selects a range of cells or chart in a
workbook and copies them. It doesn't matter where they are pasted? Is it
possible to do that through VBA? Any ideas would be really welcome!
--
Sharon

jetted[_5_]

Log when cells are copied
 

Hi Sharon

I would use these 3 macro


Sub auto_open()
'grab the user name
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0

LogFile = "c:\activite.log" ' this must be a common directory
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1
Print #1, "Excel was openned at: " & donnees & " by " &
regUserID
Close #1
end sub

Sub AUTO_CLOSE()
'close the file
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

'Dim applicationClass As New AppEventClass
'Set applicationClass.appl = Application


Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0


LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1 'pointeur adresse,
logfile=#1
Print #1, "Closed excel at " & donnees & " by " & regUserID
Print #1, "----------------------------------"
Close #1
Worksheets("Sheet1").Select
ActiveWorkbook.Save
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'as soon there is a change this is log
nom = ActiveSheet.Name

refere = Target.Address
LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
oldvalue = ActiveCell.Value
MsgBox oldvalue
Open LogFile For Append Shared As #1
Print #1, "Changes made in workbook: " & nom & " in cell: " &
refere & " new input: " & Target & " " & donnees
Close #1
'MsgBox Target
'MsgBox refere
End Sub


--
jetted
------------------------------------------------------------------------
jetted's Profile: http://www.excelforum.com/member.php...o&userid=17532
View this thread: http://www.excelforum.com/showthread...hreadid=558517


Sharon

Log when cells are copied
 
Wow!! Thank you so much - going to try it as soon as I have read through it
to understand but it looks absolutely perfect. Thanks again jetted!!
--
Sharon


"jetted" wrote:


Hi Sharon

I would use these 3 macro


Sub auto_open()
'grab the user name
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0

LogFile = "c:\activite.log" ' this must be a common directory
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1
Print #1, "Excel was openned at: " & donnees & " by " &
regUserID
Close #1
end sub

Sub AUTO_CLOSE()
'close the file
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

'Dim applicationClass As New AppEventClass
'Set applicationClass.appl = Application


Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0


LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1 'pointeur adresse,
logfile=#1
Print #1, "Closed excel at " & donnees & " by " & regUserID
Print #1, "----------------------------------"
Close #1
Worksheets("Sheet1").Select
ActiveWorkbook.Save
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'as soon there is a change this is log
nom = ActiveSheet.Name

refere = Target.Address
LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
oldvalue = ActiveCell.Value
MsgBox oldvalue
Open LogFile For Append Shared As #1
Print #1, "Changes made in workbook: " & nom & " in cell: " &
refere & " new input: " & Target & " " & donnees
Close #1
'MsgBox Target
'MsgBox refere
End Sub


--
jetted
------------------------------------------------------------------------
jetted's Profile: http://www.excelforum.com/member.php...o&userid=17532
View this thread: http://www.excelforum.com/showthread...hreadid=558517



crazybass2

Log when cells are copied
 
Sharon,

I tried 'jetted's code and it didn't seem to log when something was copied,
but rather when something was changed. I've modified the code to do what you
requested. This code will make a log entry anytime a user selects copy and
then either selects another cell, sheet, or application. The actual log is
made when the next cell, sheet, or application is selected, not when the
actual copy command is give.

There are some limitations...ie. if, in the following, the user copies
"A1:A2" and then copies "C2:C3" the second copy will not be logged because
the data on the clipboard is the same. I tried to workaround this, but was
unsuccessful.

A B C
1 Apple Orange Banana
2 Orange Banana Apple
3 Banana Apple Orange

I hope this helps you out.
Mike

Option Explicit
Dim oldclip As String
Dim clref1 As String, clref2 As String, shref1 As String, shref2 As String
Const LogFile As String = "C:\activity.log" ' this must be a common directory
Dim EnvString As String
Dim Indx As Long
Dim regUserID As String
Dim curtime As Date
Private Sub Workbook_Deactivate()
Call Workbook_SheetSelectionChange(ActiveSheet, Selection)
End Sub
Private Sub Workbook_Open()
'grab the user name

Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0
ChDir "C:\"
curtime = Now()
Open LogFile For Append Shared As #1
Print #1, "Excel was openned at: " & curtime & " by " & regUserID
Close #1
ClearClipboard
oldclip = ""
clref2 = ""
shref2 = ActiveSheet.Name
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'close the file
Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0
curtime = Now()
ChDir "C:\"
Open LogFile For Append Shared As #1 'pointeur adresse,logfile=#1
Print #1, "Closed excel at " & curtime & " by " & regUserID
Print #1, "----------------------------------"
Close #1
Worksheets("Sheet1").Select
ActiveWorkbook.Save
End Sub
Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'as soon there is a change this is log
clref1 = Selection.Address
shref1 = ActiveSheet.Name
curtime = Now()
If GetOffClipboard < oldclip And GetOffClipboard < "" Then
ChDir "C:\"
Open LogFile For Append Shared As #1
Print #1, "The range " & clref2 & " was copied from " & shref2 & " at " &
curtime & " by " & regUserID
Close #1
oldclip = GetOffClipboard
clref2 = clref1
shref2 = shref1
Else
clref2 = clref1
shref2 = shref1
End If
End Sub
Public Function GetOffClipboard() As Variant
Dim MyDataObj As New DataObject
MyDataObj.GetFromClipboard
On Error GoTo errhndrl
GetOffClipboard = MyDataObj.GetText()
Exit Function
errhndrl:
GetOffClipboard = ""
End Function
Public Sub ClearClipboard()
Dim MyDataObj As New DataObject
MyDataObj.SetText ""
MyDataObj.PutInClipboard
End Sub



"Sharon" wrote:

Wow!! Thank you so much - going to try it as soon as I have read through it
to understand but it looks absolutely perfect. Thanks again jetted!!
--
Sharon


"jetted" wrote:


Hi Sharon

I would use these 3 macro


Sub auto_open()
'grab the user name
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0

LogFile = "c:\activite.log" ' this must be a common directory
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1
Print #1, "Excel was openned at: " & donnees & " by " &
regUserID
Close #1
end sub

Sub AUTO_CLOSE()
'close the file
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

'Dim applicationClass As New AppEventClass
'Set applicationClass.appl = Application


Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0


LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1 'pointeur adresse,
logfile=#1
Print #1, "Closed excel at " & donnees & " by " & regUserID
Print #1, "----------------------------------"
Close #1
Worksheets("Sheet1").Select
ActiveWorkbook.Save
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'as soon there is a change this is log
nom = ActiveSheet.Name

refere = Target.Address
LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
oldvalue = ActiveCell.Value
MsgBox oldvalue
Open LogFile For Append Shared As #1
Print #1, "Changes made in workbook: " & nom & " in cell: " &
refere & " new input: " & Target & " " & donnees
Close #1
'MsgBox Target
'MsgBox refere
End Sub


--
jetted
------------------------------------------------------------------------
jetted's Profile: http://www.excelforum.com/member.php...o&userid=17532
View this thread: http://www.excelforum.com/showthread...hreadid=558517



crazybass2

Log when cells are copied
 
Sharon,

Because the procedure use the DataObject variable type, you must have a
reference set in your VBA project to the Microsoft Forms 2.0 object library.

In your VBA window Tools-References... and put a check in the box for
'Microsoft Forms 2.0 Object Library'

Mike

"Sharon" wrote:

Wow!! Thank you so much - going to try it as soon as I have read through it
to understand but it looks absolutely perfect. Thanks again jetted!!
--
Sharon


"jetted" wrote:


Hi Sharon

I would use these 3 macro


Sub auto_open()
'grab the user name
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0

LogFile = "c:\activite.log" ' this must be a common directory
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1
Print #1, "Excel was openned at: " & donnees & " by " &
regUserID
Close #1
end sub

Sub AUTO_CLOSE()
'close the file
Dim LogFile As String
Dim EnvString As String
Dim Indx As Long
Dim regRoot As Long

'Dim applicationClass As New AppEventClass
'Set applicationClass.appl = Application


Indx = 1
Do
EnvString = Environ(Indx)
If LCase(Left(EnvString, 9)) = "username=" Then 'Lan user id
regUserID = Right(EnvString, Len(EnvString) - 9)
End If
Indx = Indx + 1
Loop Until EnvString = ""
Indx = 0


LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
Open LogFile For Append Shared As #1 'pointeur adresse,
logfile=#1
Print #1, "Closed excel at " & donnees & " by " & regUserID
Print #1, "----------------------------------"
Close #1
Worksheets("Sheet1").Select
ActiveWorkbook.Save
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
'as soon there is a change this is log
nom = ActiveSheet.Name

refere = Target.Address
LogFile = "c:\activite.log"
ChDir "c:\"
donnees = Now()
oldvalue = ActiveCell.Value
MsgBox oldvalue
Open LogFile For Append Shared As #1
Print #1, "Changes made in workbook: " & nom & " in cell: " &
refere & " new input: " & Target & " " & donnees
Close #1
'MsgBox Target
'MsgBox refere
End Sub


--
jetted
------------------------------------------------------------------------
jetted's Profile: http://www.excelforum.com/member.php...o&userid=17532
View this thread: http://www.excelforum.com/showthread...hreadid=558517




All times are GMT +1. The time now is 11:13 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com