keilah
04-01-2008, 08:04 AM
I have the following code that work for a cell string but i cannot get it to work and track any changes when an array of cell or multiple cell are changed.
Need assistance/help in amending the code to track all changes either single or array off change at once.....if that make sense.
here is the code
Option Explicit
Option Base 1
Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'this little ditty logs all changes made to the spreadsheet in reports changes _
in sheet1
Dim bBold As Boolean
'error trapping
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
'sets the application paramters
Call ScreenPar(False, xlCalculationAutomatic, True, False, "")
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell" 'defines when the target _
cell was initially empty
bBold = Target.HasFormula 'if target has formula then set variable to true
With Sheet1
.Unprotect Password:=GlobalPassword 'unlocks worksheet
If .Cells(1, 1) = vbNullString Then 'creates report headers for the first time
.Range("A1:G1") = Array("SHEET CHANGED", "CELL CHANGED", "OLD VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE", "USER ID")
.Range("A1:G1").Font.Bold = True
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Offset(0, 0) = ActiveSheet.Name
.Offset(0, 1).Value = Target.Address 'cell address that was changed
.Offset(0, 2) = vOldVal
With .Offset(0, 3)
If bBold Then 'adds comment indicating formula
.Value = "{" & Target.Formula & "}"
Else
.Value = Target
End If
.ColumnWidth = 12
End With
.Offset(0, 4) = Time
.Offset(0, 5) = Date
.Offset(0, 5).NumberFormat = "dd mmm yy"
.Offset(0, 6) = GetUserName
End With
.Cells.Columns.Width = 12
.Protect Password:=GlobalPassword
End With
vOldVal = vbNullString
Call ScreenPar(True, xlCalculationAutomatic, True, True, "")
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub thanks
regards
Aussiebear: Edit thread to enclose code within vba tags
Need assistance/help in amending the code to track all changes either single or array off change at once.....if that make sense.
here is the code
Option Explicit
Option Base 1
Dim vOldVal
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'this little ditty logs all changes made to the spreadsheet in reports changes _
in sheet1
Dim bBold As Boolean
'error trapping
If Target.Cells.Count > 1 Then Exit Sub
On Error Resume Next
'sets the application paramters
Call ScreenPar(False, xlCalculationAutomatic, True, False, "")
If IsEmpty(vOldVal) Then vOldVal = "Empty Cell" 'defines when the target _
cell was initially empty
bBold = Target.HasFormula 'if target has formula then set variable to true
With Sheet1
.Unprotect Password:=GlobalPassword 'unlocks worksheet
If .Cells(1, 1) = vbNullString Then 'creates report headers for the first time
.Range("A1:G1") = Array("SHEET CHANGED", "CELL CHANGED", "OLD VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE", "USER ID")
.Range("A1:G1").Font.Bold = True
End If
With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Offset(0, 0) = ActiveSheet.Name
.Offset(0, 1).Value = Target.Address 'cell address that was changed
.Offset(0, 2) = vOldVal
With .Offset(0, 3)
If bBold Then 'adds comment indicating formula
.Value = "{" & Target.Formula & "}"
Else
.Value = Target
End If
.ColumnWidth = 12
End With
.Offset(0, 4) = Time
.Offset(0, 5) = Date
.Offset(0, 5).NumberFormat = "dd mmm yy"
.Offset(0, 6) = GetUserName
End With
.Cells.Columns.Width = 12
.Protect Password:=GlobalPassword
End With
vOldVal = vbNullString
Call ScreenPar(True, xlCalculationAutomatic, True, True, "")
On Error GoTo 0
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
vOldVal = Target
End Sub thanks
regards
Aussiebear: Edit thread to enclose code within vba tags