T
txheart
Hi y'all,
I used the search command and found several of your answers to thi
question, but each of them failed in the VBA for some reason. Yes, I'
in the VBA part (Alt+F11), I double clicked on ThisWorkbook, a windo
opened and I pasted the given code, one at a time, into the window
saved, exited the book, re-opened the book, and get an error eac
time.
I dont really need to track changes, since I'll be the only one makin
any changes. The other user(s) who open this are only there to ge
information that I've entered, nothing else. I'd just like to know th
few times it was opened, who and when that was, so that I can forma
the sheet accordingly.
The codes I've entered so far are as follows:
Private Sub Workbook_Open()
Dim LastRow As Long
Set sht = Sheets("Audit")
LastRow = sht.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
sht.Cells(LastRow, 1) = Environ("Username")
sht.Cells(LastRow, 2) = Now
End Sub
________________________________________________________________
Dim vOldVal 'Must be at top of module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OL
VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE O
CHANGE")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10)
_
"Bold values are the results o
formulas"
End If
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
vOldVal = Target
End Sub
Track/Report User Changes on all Worksheets in 1 Workbook
The code below must be placed in the Private Module of the Workboo
(ThisWorkbook) you would like changes tracked and logged. To easily ge
there right click on the excel icon, top left next to File and choos
View Code. In here paste the code below;
Dim vOldVal 'Must be at top of module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OL
VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE O
CHANGE")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10)
_
"Bold values are the results o
formulas"
End If
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVa
Target As Range)
vOldVal = Target
End Sub
_________________________________________________________________
Private Declare Function GetUserName Lib "advapi32.dll" Alia
"GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alia
"GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private pAuditSheet As Worksheet
Private Const USERNAME_COL = 1
Private Const COMPUTERNAME_COL = 2
Private Const OPEN_TIME_COL = 3
Private Const CLOSE_TIME_COL = 4
Private Const OPEN_WB_NAME_COL = 5
Private Const CLOSE_WB_NAME_COL = 6
Private Const KEEP_ONLY_LAST_N_ENTRIES = 10
Private Sub Workbook_Open()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_Open
' Runs when the workbook is opened.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WS As Worksheet
Dim RowNum As Long
Dim N As Long
Dim S As String
Application.ScreenUpdating = False
On Error Resume Next
Err.Clear
Set WS = Me.Worksheets("Audit")
If Err.Number = 9 Then
Set WS = Me.Worksheets.Add(before:=1)
WS.Name = "Audit"
End If
On Error GoTo 0
With WS
If .Cells(1, USERNAME_COL).Value = vbNullString Then
.Cells(1, USERNAME_COL).Value = "User Name"
.Cells(1, COMPUTERNAME_COL).Value = "Computer Name"
.Cells(1, OPEN_TIME_COL).Value = "Open Time"
.Cells(1, CLOSE_TIME_COL).Value = "Close Time"
.Cells(1, OPEN_WB_NAME_COL).Value = "Open WB Name"
.Cells(1, CLOSE_WB_NAME_COL).Value = "Close WB Name"
End If
.Visible = xlSheetVeryHidden
RowNum = .Cells(.Rows.Count, USERNAME_COL).End(xlUp)(2, 1).Row
N = 255
S = String(N, vbNullChar)
N = GetUserName(S, N)
.Cells(RowNum, USERNAME_COL).Value = TrimToNull(S)
N = 255
S = String(N, vbNullChar)
N = GetComputerName(S, N)
.Cells(RowNum, COMPUTERNAME_COL).Value = TrimToNull(S)
.Cells(RowNum, OPEN_TIME_COL).Value = Now
' Leave Close Time empty. It will be filled on close.
.Cells(RowNum, CLOSE_TIME_COL).Value = vbNullString
.Cells(RowNum, OPEN_WB_NAME_COL).Value = ThisWorkbook.FullName
' Leave Close Name empty. It will be filled on close.
.Cells(RowNum, CLOSE_WB_NAME_COL).Value = vbNullString
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Runs when the workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WS As Worksheet
Dim RowNum As Long
Dim EndRow As Long
Dim LastDel As Long
Dim FirstDel As Long
Application.ScreenUpdating = False
Set WS = Worksheets("Audit")
With WS
RowNum = .Cells(.Rows.Count, CLOSE_TIME_COL).End(xlUp).Row + 1
.Cells(RowNum, CLOSE_TIME_COL).Value = Now
.Cells(RowNum, CLOSE_WB_NAME_COL).Value =
ThisWorkbook.FullName
.UsedRange.Columns.AutoFit
If KEEP_ONLY_LAST_N_ENTRIES > 0 Then
EndRow = .Cells(.Rows.Count, USERNAME_COL).End(xlUp).Row
If EndRow > 2 Then
FirstDel = 2
LastDel = EndRow - KEEP_ONLY_LAST_N_ENTRIES
If LastDel > 2 Then
.Cells(FirstDel, "A").Resize(LastDel - 1,
1).Select
End If
End If
End If
End With
Application.ScreenUpdating = True
End Sub
Private Function TrimToNull(S As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''
' TrimToNull
' Returns the portion of string S that is to the
' left of the vbNullChar, Chr(0).
'''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
N = InStr(1, S, vbNullChar)
If N = 0 Then
TrimToNull = S
Else
TrimToNull = Left(S, N - 1)
End If
End Function
''''''''''''''''''''''''''''''''''''''''''
' END CODE
''''''''''''''''''''''''''''''''''''''''''
Any ideas?
I used the search command and found several of your answers to thi
question, but each of them failed in the VBA for some reason. Yes, I'
in the VBA part (Alt+F11), I double clicked on ThisWorkbook, a windo
opened and I pasted the given code, one at a time, into the window
saved, exited the book, re-opened the book, and get an error eac
time.
I dont really need to track changes, since I'll be the only one makin
any changes. The other user(s) who open this are only there to ge
information that I've entered, nothing else. I'd just like to know th
few times it was opened, who and when that was, so that I can forma
the sheet accordingly.
The codes I've entered so far are as follows:
Private Sub Workbook_Open()
Dim LastRow As Long
Set sht = Sheets("Audit")
LastRow = sht.Cells(Cells.Rows.Count, "A").End(xlUp).Row + 1
sht.Cells(LastRow, 1) = Environ("Username")
sht.Cells(LastRow, 2) = Now
End Sub
________________________________________________________________
Dim vOldVal 'Must be at top of module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OL
VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE O
CHANGE")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10)
_
"Bold values are the results o
formulas"
End If
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
vOldVal = Target
End Sub
Track/Report User Changes on all Worksheets in 1 Workbook
The code below must be placed in the Private Module of the Workboo
(ThisWorkbook) you would like changes tracked and logged. To easily ge
there right click on the excel icon, top left next to File and choos
View Code. In here paste the code below;
Dim vOldVal 'Must be at top of module
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target A
Range)
Dim bBold As Boolean
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell"
bBold = Target.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:E1") = Array("CELL CHANGED", "OL
VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE O
CHANGE")
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Value = Target.Address
.Offset(0, 1) = vOldVal
With .Offset(0, 2)
If bBold = True Then
.ClearComments
.AddComment.Text Text:= _
"OzGrid.com:" & Chr(10) & "" & Chr(10)
_
"Bold values are the results o
formulas"
End If
.Value = Target
.Font.Bold = bBold
End With
.Offset(0, 3) = Time
.Offset(0, 4) = Date
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
End With
vOldVal = vbNullString
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVa
Target As Range)
vOldVal = Target
End Sub
_________________________________________________________________
Private Declare Function GetUserName Lib "advapi32.dll" Alia
"GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private Declare Function GetComputerName Lib "kernel32" Alia
"GetComputerNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Private pAuditSheet As Worksheet
Private Const USERNAME_COL = 1
Private Const COMPUTERNAME_COL = 2
Private Const OPEN_TIME_COL = 3
Private Const CLOSE_TIME_COL = 4
Private Const OPEN_WB_NAME_COL = 5
Private Const CLOSE_WB_NAME_COL = 6
Private Const KEEP_ONLY_LAST_N_ENTRIES = 10
Private Sub Workbook_Open()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_Open
' Runs when the workbook is opened.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WS As Worksheet
Dim RowNum As Long
Dim N As Long
Dim S As String
Application.ScreenUpdating = False
On Error Resume Next
Err.Clear
Set WS = Me.Worksheets("Audit")
If Err.Number = 9 Then
Set WS = Me.Worksheets.Add(before:=1)
WS.Name = "Audit"
End If
On Error GoTo 0
With WS
If .Cells(1, USERNAME_COL).Value = vbNullString Then
.Cells(1, USERNAME_COL).Value = "User Name"
.Cells(1, COMPUTERNAME_COL).Value = "Computer Name"
.Cells(1, OPEN_TIME_COL).Value = "Open Time"
.Cells(1, CLOSE_TIME_COL).Value = "Close Time"
.Cells(1, OPEN_WB_NAME_COL).Value = "Open WB Name"
.Cells(1, CLOSE_WB_NAME_COL).Value = "Close WB Name"
End If
.Visible = xlSheetVeryHidden
RowNum = .Cells(.Rows.Count, USERNAME_COL).End(xlUp)(2, 1).Row
N = 255
S = String(N, vbNullChar)
N = GetUserName(S, N)
.Cells(RowNum, USERNAME_COL).Value = TrimToNull(S)
N = 255
S = String(N, vbNullChar)
N = GetComputerName(S, N)
.Cells(RowNum, COMPUTERNAME_COL).Value = TrimToNull(S)
.Cells(RowNum, OPEN_TIME_COL).Value = Now
' Leave Close Time empty. It will be filled on close.
.Cells(RowNum, CLOSE_TIME_COL).Value = vbNullString
.Cells(RowNum, OPEN_WB_NAME_COL).Value = ThisWorkbook.FullName
' Leave Close Name empty. It will be filled on close.
.Cells(RowNum, CLOSE_WB_NAME_COL).Value = vbNullString
.UsedRange.Columns.AutoFit
End With
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Workbook_BeforeClose
' Runs when the workbook is closed.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim WS As Worksheet
Dim RowNum As Long
Dim EndRow As Long
Dim LastDel As Long
Dim FirstDel As Long
Application.ScreenUpdating = False
Set WS = Worksheets("Audit")
With WS
RowNum = .Cells(.Rows.Count, CLOSE_TIME_COL).End(xlUp).Row + 1
.Cells(RowNum, CLOSE_TIME_COL).Value = Now
.Cells(RowNum, CLOSE_WB_NAME_COL).Value =
ThisWorkbook.FullName
.UsedRange.Columns.AutoFit
If KEEP_ONLY_LAST_N_ENTRIES > 0 Then
EndRow = .Cells(.Rows.Count, USERNAME_COL).End(xlUp).Row
If EndRow > 2 Then
FirstDel = 2
LastDel = EndRow - KEEP_ONLY_LAST_N_ENTRIES
If LastDel > 2 Then
.Cells(FirstDel, "A").Resize(LastDel - 1,
1).Select
End If
End If
End If
End With
Application.ScreenUpdating = True
End Sub
Private Function TrimToNull(S As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''
' TrimToNull
' Returns the portion of string S that is to the
' left of the vbNullChar, Chr(0).
'''''''''''''''''''''''''''''''''''''''''''''''''''
Dim N As Long
N = InStr(1, S, vbNullChar)
If N = 0 Then
TrimToNull = S
Else
TrimToNull = Left(S, N - 1)
End If
End Function
''''''''''''''''''''''''''''''''''''''''''
' END CODE
''''''''''''''''''''''''''''''''''''''''''
Any ideas?