Tracking Worksheet changes in excel workbook - VBA (Run time error 13)

[djspod]

Hi ,

I have some really good vba code which works brilliantly to log changes to a hidden Log Sheet.
Time, name, sheet name, old value and new value.
Stores all changes flawlessly however a VBA error needs fixing "Run-time error 13 type mismatch

I'm guessing something like Error handling needs putting in place but my VBA Skill base is still in the learning stages and I need a little support

Can anyone help please?

Everything is fine until a user selects more than one cell at a time on any worksheet, the code then breaks. (files attached - VBA Password is: Test - Capital T)

https://drive.google.com/file/d/0B6rF_bjMGY5pVXFFYk1YZnVwTG8/view?usp=sharing

Dim oldValue As String
Dim oldAddress As String

Private Sub Workbook_Open()
Sheets("LogDetails").Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Sheets("LogDetails").Visible = xlSheetVisible Then
Sheets("LogDetails").Visible = xlSheetVeryHidden
Else
Sheets("LogDetails").Visible = xlSheetVisible
End If
Target.Offset(1, 1).Select
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = "WC 28.08.2016"
sSheetName = "WC 21.08.2016"
sSheetName = "WC 14.08.2016"
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & " - " & Target.Address(0, 0)
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress
Sheets("LogDetails").Columns("A:D").AutoFit
Application.EnableEvents = True
End If
End Sub

 

[JLGWhiz]

Two mods. One line added to prevent errors caused by selecting more than one cell at a time. An error trap added to detect any errors other than error 13. If you Don't want the error trap, you can comment out the On Error line and the entire If...Then...End If state near the end.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
 Dim sSheetName As String
 sSheetName = "WC 28.08.2016"
 sSheetName = "WC 21.08.2016"
 sSheetName = "WC 14.08.2016"
 On Error GoTo SKIP:
 If ActiveSheet.Name <> "LogDetails" Then
 Application.EnableEvents = False
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & " - " & Target.Address(0, 0)
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
 Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress
 Sheets("LogDetails").Columns("A:D").AutoFit
SKIP:
    If Err.Number > 0 And Err.Number <> "13" Then
        MsgBox Err.Number & ":  " & Err.Description
    End If
 Application.EnableEvents = True
 End If
 End Sub

 

[djspod]

Hi JLGWhiz

Thanks for taking the time to look at my problem (Much appreciated!!)

I have re added the code that you posted, I like the logic, it does make some sense to me as a VBA novice.

However the code still breaks when it hits Line 47 on the Debug (Highlighted in RED below: OldValue = Target.value )

Any ideas?

and thanks for the help so far

Dim oldValue As StringDim oldAddress As String




Private Sub Workbook_Open()
Sheets("LogDetails").Visible = xlSheetVeryHidden
End Sub


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Sheets("LogDetails").Visible = xlSheetVisible Then
Sheets("LogDetails").Visible = xlSheetVeryHidden
Else
Sheets("LogDetails").Visible = xlSheetVisible
End If
Target.Offset(1, 1).Select
End Sub




Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim sSheetName As String
sSheetName = "WC 28.08.2016"
sSheetName = "WC 21.08.2016"
sSheetName = "WC 14.08.2016"
On Error GoTo SKIP:
If ActiveSheet.Name <> "LogDetails" Then
Application.EnableEvents = False
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & " - " & Target.Address(0, 0)
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress
Sheets("LogDetails").Columns("A:D").AutoFit
SKIP:
If Err.Number > 0 And Err.Number <> "13" Then
MsgBox Err.Number & ": " & Err.Description
End If
Application.EnableEvents = True
End If
End Sub






Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
oldValue = Target.Value
oldAddress = Target.Address
End Sub

 

[JLGWhiz]

If this is like this in your code module, I am surprised that you don't get an error here. Dim can only be used once on a single line.

Dim oldValue As StringDim oldAddress As String

Should be

Dim oldValue As String
Dim oldAddress As String
'or
Dim oldValue As String, oldAddress As String

For the error you are getting, you could try adding an If statement

If Target.Value <> "" Then
'your existing code
End If

 

[djspod]

Hi,

The Dim code was correct, I must have copied and pasted over wrong so no issues there.

I've added the new code that you suggested

[/If Target.Value <> "" Then
'your existing code
End IfCODE]

Bizarrely the code is still breaking if you make a selection of more than 1 cell at a time?   Error 13 type Mis match

Unless I have added the code in the wrong place?




[QUOTE]Dim oldValue As String
Dim oldAddress As String

Private Sub Workbook_Open()
Sheets("LogDetails").Visible = xlSheetVeryHidden
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
If Sheets("LogDetails").Visible = xlSheetVisible Then
Sheets("LogDetails").Visible = xlSheetVeryHidden
Else
Sheets("LogDetails").Visible = xlSheetVisible
End If
Target.Offset(1, 1).Select
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
 If Target.Cells.Count > 1 Then Exit Sub
 Dim sSheetName As String
 sSheetName = "WC 28.08.2016"
 sSheetName = "WC 21.08.2016"
 sSheetName = "WC 14.08.2016"
 On Error GoTo SKIP:
 If ActiveSheet.Name <> "LogDetails" Then
 Application.EnableEvents = False
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = ActiveSheet.Name & " - " & Target.Address(0, 0)
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 1).Value = oldValue
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 2).Value = Target.Value
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 3).Value = Environ("username")
 Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 4).Value = Now
 Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & sSheetName & "'!" & oldAddress, TextToDisplay:=oldAddress
 Sheets("LogDetails").Columns("A:D").AutoFit
SKIP:
 If Err.Number > 0 And Err.Number <> "13" Then
 MsgBox Err.Number & ": " & Err.Description
 End If
 Application.EnableEvents = True
 End If
 End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> "" Then
oldValue = Target.Value
oldAddress = Target.Address
End If
End Sub
[/QUOTE]

Link attached for a screen shot and the Excel Spreadsheet.

[URL]https://drive.google.com/file/d/0B6rF_bjMGY5pTl8zRDhRYXlNZ1U/view?usp=sharing[/URL]

Once again thanks for the help

 

[JLGWhiz]

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
[COLOR=#DAA520]If Target.Cells.Count > 1 Then 
       MsgBox "Select only one cell"
       Exit Sub
End if
[/COLOR][COLOR=#ff0000][B]oldValue = Target.Value[/B][/COLOR]
 oldAddress = Target.Address
 End Sub

Try this. It will not allow the code to run any further if more than one cell is selected, but it will not display the VB editor to the user. I also would change the public declaration for 'oldValue' to variant rather than string, since the cell value selected could be other than data type string.

 

[djspod]

The last code worked brilliant!!

Thanks for your support , very much appreciated.

Cheers