Need some VBA Help

[Nacky]

Hi all,


I created a test workbook so I can work on a way to capture and record user activity in my workbooks, and record any changes made into a log.txt file, and then email the log file to me.


We've recently had problems with workbooks being modified without proper authorization so I needed something quick and dirty to catch the culprit.


The idea here is to try to *rollback* any changes made after a file was saved using the data captured in the log. Sounds pretty simple right?


My problem is: The code works fine, and quite efficiently (its so quick, the user doesn't even know it ran). But... I haven't figured out a way to capture changes made to multiple ranges at a time.


For Example: If a User Selects A1 to A5, and then puts 1,2,3,4,5 into those cells, it won't record it. Because Target.Value won't give me anything if the Target.Address = "$A$1:$A$5"


I don't have cloud storage or a free account to any webiste to store my file for your viewing and testing pleasures.


email me @ nackyk@live.ca if you're interesting in solving this problem so I can send you this file (currently I'm at work, and can't post the file (security reasons).


Have a nice day fellas.


Nacky

 

[Luke M]

(assuming the Shared workbook & track changes options is a no-go)

Taking the method from here:

http://www.pcreview.co.uk/forums/trach-changes-without-sharing-workbook-t3240741.html


I was able to include a loop in the LogChanges macro that "seems" to handle multiple cells. New ChangeLog macro:

[pre]

Sub LogChanges(ByVal vOldVal, ByVal Target As Range, ByVal Sh As Object)

Dim bHasFormula As Boolean
Dim c As Range

For Each c In Target
'Luke M: Commented out the following lines
'If Target.Cells.Count > 1 Then Exit Sub
'On Error Resume Next

If IsEmpty(vOldVal) Then vOldVal = "[Empty Cell]"
bHasFormula = c.HasFormula
With Sheet1
.Unprotect Password:="Secret"
If .Range("A1") = vbNullString Then
.Range("A1:H1") = Array("#", "CELL CHANGED", "NUMCELLS", "OLD VALUE", _
"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE", "USERID")
End If

With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
.Formula = "=Row()-1"
.Offset(0, 1) = c.Worksheet.Name & "!" & c.Address
.Offset(0, 2) = c.Cells.Count
.Offset(0, 3) = vOldVal

With .Offset(0, 4)
If bHasFormula = True Then
.Formula = "'" & .Formula
c.Copy
.PasteSpecial (xlPasteFormats)
Else
c.Copy
.PasteSpecial (xlPasteAll)
End If
End With

.Offset(0, 5) = Time
.Offset(0, 6) = Date
.Offset(0, 7) = Application.UserName
End With
.Cells.Columns.AutoFit
.Protect Password:="Secret"
.Visible = xlSheetHidden
End With
vOldVal = vbNullString

Next
End Sub
Hopefully it gives you some ideas. Depending on your macro, you might be able to do a similar

For each c in Target

[/pre]
trick. Hope that helps.

 

[Nacky]

Hi Luke,


Thanks for the quick reply, that looks a lot like what I wanted to do. I'll give it a shot when I go in to work tomorrow.


I'll let ya know how it works out


Nacky

 

[Nacky]

Hi again,


The code you posted above worked great when modifying single cells, but didn't not capture the old value of a range of cells properly. I've made the following changes (More comments below code snippet):


:: In ThisWorkbook :


Option Explicit

Option Base 1 'Nacky: Added this to accomodate a minimum range of selected cells to 1.


Dim vOldVal() 'Nacky: switched this to an Array.


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

'Nothing was changed in this routine.


With Application

.ScreenUpdating = False

.EnableEvents = False

.Calculation = xlCalculationManual

End With


Call LogChanges(vOldVal, Target, Sh)


With Application

.ScreenUpdating = True

.EnableEvents = True

.Calculation = xlCalculationAutomatic

End With


End Sub


Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

Dim rng As Range

Dim i As Long


'Nacky: Made vOldVal into an Array with an Ubound() = to the number of cells selected


i = 1 'necessary for Lbound() position

ReDim vOldVal(Target.Cells.Count)


'Nacky: Included a Loop to populate array with Old Values.

For Each rng In Target

vOldVal(i) = rng.Value

i = i + 1

Next

End Sub


:: In a Module ::


Option Base 1 'Needed for Array Lbound() value


Sub LogChanges(ByVal vOldVal, ByVal Target As Range, ByVal Sh As Object)


Dim bHasFormula As Boolean

Dim c As Range

Dim i As Long


i = 1


For Each c In Target

'Luke M: Commented out the following lines

'If Target.Cells.Count > 1 Then Exit Sub

'On Error Resume Next


If IsEmpty(vOldVal(i)) Then vOldVal(i) = "[Empty Cell]" 'Nacky: Changed this to check current array position

bHasFormula = Target.HasFormula

With Sheet1

'.Unprotect Password:="Secret"

If .Range("A1") = vbNullString Then

.Range("A1:H1") = Array("#", "CELL CHANGED", "NUMCELLS", "OLD VALUE", _

"NEW VALUE", "TIME OF CHANGE", "DATE OF CHANGE", "USERID")

End If


With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)

.Formula = "=Row()-1"

.Offset(0, 1) = c.Worksheet.Name & "!" & c.Address

.Offset(0, 2) = c.Cells.Count

.Offset(0, 3) = vOldVal(i) 'Nacky: Changed to Array variable


With .Offset(0, 4)

If bHasFormula = True Then

.Formula = "'" & .Formula

c.Copy

.PasteSpecial (xlPasteFormats)

Else

c.Copy

.PasteSpecial (xlPasteAll)

End If

End With


.Offset(0, 5) = Time

.Offset(0, 6) = Date

.Offset(0, 7) = Application.UserName

End With

.Cells.Columns.AutoFit

'.Protect Password:="Secret"

'.Visible = xlSheetHidden

End With

i = i + 1 ' Nacky: added counter

Next

End Sub

This works fine for single selected cells, and selecting Cells of equal range values (Selecting Range A1:A5, Copy. Then Select Cell B1:B5 and Paste. This works).

Problems remaining to solve:


-Selecting & Copying Multiple Cells, then selecting 1 Cell and Pasting will only cause the first value of the array to be pasted in the *OldValue* column.

-Selecting multiple cells and copying, then selecting multiple cells that do not match the number of selected cells in the Copy process yields an error. (i.e. If I pick 5 cells to copy, then highlight 3 cells and paste, errors occurs.)


Tomorrow I'll need to improve the logic of stepping through the array while the array counter has not reached the limit of its UBOUND() value since the "For Each c" loop will only loop once if the Paste Location has only 1 cell selected.


Nacky

 

[Nacky]

Also to add another point to the problem:


-If I click on a cell and try to copy it down (use the + symbol of the selected cell), it will only show the first value in the Log. Actually, I think this may still cause an error to come up. Needs to be tested with above code.

- I haven't tried it yet, but I'm guessing dragging a cell into an adjacent cell will yield the same problem.


Nacky

 

[Nacky]

Almost there!


I had to change my approach a bit with the whole stepping through the array since that wasn't the cause of one of my dilemnas. Instead, I switched the Dim vOldVal() to Dim vOldVal and removed the array initialization, then added a check to see if more than 1 cell was chosen and ReDim the variable if necessary if the cell count was more than 1.


Unfortunately, I had to double up on the code in the LogChanges() routine to accomodate an "If isArray()" check to avoid errors after this change.


Problems remaining to solve:

- Fix the issue with the Old Value not being logged when Dragging down a cell (+) symbol.

-Put a limit to the number of cells the log will record, to avoid recording the copy/pasting of entire columns/rows into the log sheet.

-Any more, so far, unforseen possibility of errors.