Code Reuse - Logging Actions When a Cell Changes

**webbug08** · 04-28-2009, 01:23 PM

Hi all,

I am trying to use following codes for a add-in utility so that user can enable or disable logging activity for a given workbook.
My problem is to how to add the following code to a new workbook so that "Loginfo" function could be activated. I have tried some application... based commands but it do not seem to be working.

Private Sub Workbook_SheetChange(ByVal Sh As Object, _
ByVal Target As Range)
If TypeName(Sh) = "Worksheet" Then
LogInfo Target
End If
End Sub

Is there is any way to add this code to a new workbook using code or any alternative to this activity?
Complete code is mentioned below.

Thanks,
Webbug

Option Explicit
' * * * * *
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
' * * * * *
Sub LogInfo(ByVal Target As Range)
'Variable declaration
Dim FilePath As String
Dim File As Long
Dim Length As Long
Dim Workbook As String
Dim Worksheet As String
Dim Address As String
Dim Value As Variant
Dim Username As String
Dim TimeStamp As Date
Dim Formula As String
Dim Cell As Range
'The log file will contain:
'Workbook full name, Worksheet, Range address,
'New Value, Formula, Username and a time stamp
FilePath = "\\Server\apps\logme.csv"
FilePath = "C:\logme.csv"
'Open the file
File = FreeFile
Open FilePath For Append As #File
Length = LOF(File)
If Length = 0 Then
'Put some headers
Write #File, "Workbook", "Worksheet", "Range", "Value", _
"Formula", "Username", "Date";
End If
'Loop through the cells
For Each Cell In Target.Cells
With Cell
Workbook = .Worksheet.Parent.FullName
Worksheet = .Worksheet.Name
Address = .Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
Value = .Value
If .HasFormula Then
Formula = .Formula
Else
Formula = ""
End If
Username = GetWinUserName()
TimeStamp = Now()
End With
'Write the information
Write #File, Workbook, Worksheet, Address, Value, Formula, _
Username, TimeStamp
Next Cell
Close #File
End Sub
' * * * * *
Function GetWinUserName()
'Variable declaration
Dim strUserName As String
strUserName = String(255, Chr$(0))
GetUserName strUserName, 255
strUserName = Left$(strUserName, InStr(strUserName, _
Chr$(0)) - 1)
GetWinUserName = strUserName
End Function

**webbug08** · 04-29-2009, 12:53 PM

Look forward for reply guys....

**broro183** · 04-30-2009, 05:58 PM

hi Govind

To prevent any confusion I suggest changing your variables so that they do not use the same names as inbuilt objects in EXcel's VBA object model ie:

Option Explicit
' * * * * *
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
' * * * * *
Sub LogInfo(ByVal Target As Range)
'Variable declaration
Dim FPath As String
Dim FileNum As Long
Dim Length As Long
Dim Wkbk As String
Dim Wksht As String
Dim Addr As String
Dim Val As Variant
Dim Username As String
Dim TimeStamp As Date
Dim Frmla As String
Dim Cll As Range
'The log file will contain:
'Workbook full name, Worksheet, Range address,
'New Value, Formula, Username and a time stamp
FPath = "\\Server\apps\logme.csv"
FPath = "C:\logme.csv"
'Open the file
FileNum = FreeFile
Open FPath For Append As #FileNum
Length = LOF(FileNum)
If Length = 0 Then
'Put some headers
Write #FileNum, "Workbook", "Worksheet", "Range", "Value", _
"Formula", "Username", "Date";
End If
'Loop through the cells
For Each Cll In Target.Cells
With Cll
Wkbk = .Worksheet.Parent.FullName
Wksht = .Worksheet.Name
Addr = .Address(RowAbsolute:=False, _
ColumnAbsolute:=False)
Val = .Value
If .HasFormula Then
Frmla = .Formula
Else
Frmla = ""
End If
Username = GetWinUserName()
TimeStamp = Now()
End With
'Write the information
Write #FileNum, Wkbk, Wksht, Addr, Val, Frmla, _
Username, TimeStamp
Next Cll
Close #FileNum
End Sub
' * * * * *
Function GetWinUserName()
'Variable declaration
Dim strUserName As String
strUserName = String(255, Chr$(0))
GetUserName strUserName, 255
strUserName = Left$(strUserName, InStr(strUserName, _
Chr$(0)) - 1)
GetWinUserName = strUserName
End Function

No promises, but you may find the below useful for guided discovery...
Or, someone with more knowledge may step in & provide a definitive response - fingers crossed!

You may* find useful info on Chip's site to allow this code (in an add-in) to work on any open workbook:
*(I haven't read the entire article)
http://www.cpearson.com/excel/Events.aspx
&
http://www.cpearson.com/excel/AppEvent.aspx

To add the code to another workbook using code have a look at:
http://vba2008.wordpress.com/2008/10...ing-excel-vba/
or some of the links on:
http://vbadud.blogspot.com/2008_10_01_archive.html

hth
Rob

**webbug08** · 05-01-2009, 12:24 AM

Dear Rob,

Thanks for all your help.

Govind

**broro183** · 05-01-2009, 07:50 AM

Thanks for the feedback

I'm not really sure how much help I've been but...

Once you have a working solution, would you be able to post it to this thread?
- It will help any others who review this thread looking for answers to their specific problems.
- I'll be able to learn the technique myself without having to do all the testing ;-)

Thanks
Rob

**webbug08** · 05-01-2009, 02:03 PM

Sure..
I have got a link on this forum
http://www.excelforum.com/excel-prog...in-add-in.html

I am trying to understand this one..I am bit new to programming. It will take me some time to get this done. I will surely put as soon as i finish making it.

Thanks,
Govind