track changes to worksheet with VBA

N

nparsons75

Well-known Member
Joined
Sep 23, 2013
Messages
1,256
Office Version
  1. 2016
Has anyone ever tried to track changes with VBA. I am currently tring this solution:
HTML: 
http://sourcedaddy.com/ms-excel/track-changes-particular-worksheet.html

The code it states to use is this: I am getting red lines for some reason as in the code, I also get an error when i try it out. Compile Error: Syntax Error:

Hope someone can help I cannot for the life of me get this to work...


Code: 
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 Sheet2
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
[COLOR=#ff0000]            .Range("A1:E1") = Array("CELL CHANGED",[/COLOR]
[COLOR=#ff0000]                    "OLD VALUE", _[/COLOR]
[COLOR=#ff0000]            "NEW VALUE", "TIME OF CHANGE", "DATE OF[/COLOR]
                        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
[COLOR=#ff0000]            .AddComment.Text Text:= _[/COLOR]
[COLOR=#ff0000]                "OzGrid.com:" & Chr(10) & "" &[/COLOR]
                            Chr (10) & _
                "Bold values are the results of"
                                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
 
Last edited by a moderator:

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Sort by date Sort by votes
Try
Code: 
Option Explicit

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 Sheet8
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
            .Range("A1:E1") = Array("CELL CHANGED", _
                    "OLD VALUE", _
            "NEW VALUE", "TIME OF CHANGE", "DATE OF 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 of 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
 
Upvote 0
Hi, thanks for the help. I think its getting closer, however this time I got an abiguous name error on this area of code:

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range) vOldVal = Target
End Sub

It happens whenever i select a cell
 
Last edited:
Upvote 0
Do you have two SelectionChange events in the worksheet?
 
Upvote 0
That suggests that you have 2 Worksheet_SelectionChange events in the same sheet, which you can't have.
Can you post the other code?
 
Upvote 0
Strange, the only code I have for this workbook is the code you had. Is there 2 within this code? There are two at the bottom?



Code: 
Option Explicit

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 Sheet8
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
            .Range("A1:E1") = Array("CELL CHANGED", _
                    "OLD VALUE", _
            "NEW VALUE", "TIME OF CHANGE", "DATE OF 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 of 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
    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


This is the original code

Code: 
[COLOR=#000000]Dim vOldVal 'Must be at top of module[/COLOR]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 Sheet2
	    .Unprotect Password:="Secret"
		If .Range("A1") = vbNullString Then
		    .Range("A1:E1") = Array("CELL CHANGED",
                    "OLD VALUE", _
			"NEW VALUE", "TIME OF CHANGE", "DATE OF
                        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 of
                                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 [COLOR=#000000]End Sub[/COLOR]
 
Last edited:
Upvote 0
Delete everything in that module & then copy & paste the code from post#2 again.
It looks as though you may not have completely removed the previous code before.
 
Upvote 0
As you say... thank you

I seem to have fixed it....

The code at the bottom should not have been there, copy paste issue I think...

There was also a 8 in sheet8 as part of the formula, changed to sheet2 and it works...

Code: 
Option Explicit

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 Sheet2
        '.Unprotect Password:="Secret"
        If .Range("A1") = vbNullString Then
            .Range("A1:E1") = Array("CELL CHANGED", _
                    "OLD VALUE", _
            "NEW VALUE", "TIME OF CHANGE", "DATE OF 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 of 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
 
Last edited:
Upvote 0
Glad it's sorted & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
VBA to log deleted row
Replies
2
Views
622
kizzie37
K
K
  • Question Question
Merge aspects of 2 pieces of VBA Code
Replies
6
Views
494
kizzie37
K
S
  • Question Question
Excel VBA Help
Replies
1
Views
71
DanteAmor
DanteAmor
J
  • Solved
Run time error for Worksheet Change in VBA
2
Replies
17
Views
430
jtemp57
J
M
  • Question Question
Add text before pasting pic in outlook
Replies
2
Views
79
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,905
Messages
6,175,297
Members
452,633
Latest member
DougMo

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top