VBA Code for User log history

[Kevo]

Hello
Can you please assist with correcting the below VBA code as i am getting an error on the text in yellow-"Run-time error '13': Type mismatch." .Really appreciate any help here. Thanks in advance.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C6:X999")) Is Nothing And Range("C" & Target.Row).Value <> Empty Then
If Changes.Range("H2").Value) = Target.Value Then Exit Sub
Dim ChngRow As Long
With Changes
ChngRow = .Range("A99999").End(xlUp).Row + 1
.Range("A" & ChngRow).Value = ThisWorkbook.BuiltinDocumentProperties("Last Author")
.Range("B" & ChngRow).Value = ActiveSheet.Name
.Range("C" & ChngRow).Value = Target.Address
.Range("D" & ChngRow).Value = .Range("H2").Value
.Range("E" & ChngRow).Value = Target.Value

End With
End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C6:X999")) Is Nothing And Range("C" & Target.Row).Value <> Empty Then
Changes.Range("H2").Value = Target.Value

End If
End Sub

 

[Kevo]

its not working.....Can you please show me what you mean

 

[Joe4]

You also have another error in that line. I am not sure why you have a ")" after the word "Value", but that should not be there.

So your first code would look like this:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Changes As Worksheet
Set Changes = Sheets("Changes")

If Not Intersect(Target, Range("C6:X999")) Is Nothing And Range("C" & Target.Row).Value <> Empty Then
If Changes.Range("H2").Value = Target.Value Then Exit Sub
Dim ChngRow As Long
With Changes
ChngRow = .Range("A99999").End(xlUp).Row + 1
.Range("A" & ChngRow).Value = ThisWorkbook.BuiltinDocumentProperties("Last Author")
.Range("B" & ChngRow).Value = ActiveSheet.Name
.Range("C" & ChngRow).Value = Target.Address
.Range("D" & ChngRow).Value = .Range("H2").Value
.Range("E" & ChngRow).Value = Target.Value

End With
End If
End Sub

And your second like this:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim Changes As Worksheet
Set Changes = Sheets("Changes")

If Not Intersect(Target, Range("C6:X999")) Is Nothing And Range("C" & Target.Row).Value <> Empty Then
Changes.Range("H2").Value = Target.Value

End If
End Sub

If it still does not work, then you still have other issues. Probably logic issues. And that is where I need that explanation from you.

 

[Kevo]

thanks for all your help, however now its showing a Run-time error "9": Subscript out of range on Set Changes = Sheets("Changes")
My Logic and explanation is exactly from the youtube link i provided which was followed exactly.

You can close this thread as unresolved just in case other users come across the same issue and looking for a solution

 

[Joe4]

thanks for all your help, however now its showing a Run-time error "9": Subscript out of range on Set Changes = Sheets("Changes")

In post #3, you said "Changes" was the name of the sheet.
However, if you are really doing EXACTLY what is shown in that video, the name of the sheet is NOT "Changes", but rather "Change History".

So if your sheet is really named "Change History", then this line:

Set Changes = Sheets("Changes")

would actually need to be:

Set Changes = Sheets("Change History")

 

[Joe4]

OK, I think I finally figured out what they were doing. They left off a very important detail in that video. I took a screen grab, and notice the line I highlighted in yellow:

So it appears that what they did was go into the VBA Project Explorer, bring up the sheet properties, and rename the sheet reference there.
Then, they can reference "Changes" like they did without having to declare or set its value in the code.

So it would look something like this initially:

And then you would change the (Name) value in the lower box like this:

It would have been helpful if they explained that part!

 

[Kevo]

Yes......Is there a solution to fix this?

 

[Kevo]

if i could send you my excel file i would, which shows that the code works but not fully

if you remove the If Changes.Range("H2").Value = Target.Value Then Exit Sub from the code then the code works however if you double click on a cell it reflects that as a change, and if you copy or drag a cell down to another row then it gives run-time error"13" mismatch

 

[Joe4]

Yes......Is there a solution to fix this?

I am not sure what you mean - my last post shows you exactly how to fix it, complete with screen prints.

 

[Joe4]

if i could send you my excel file i would, which shows that the code works but not fully

if you remove the If Changes.Range("H2").Value = Target.Value Then Exit Sub from the code then the code works however if you double click on a cell it reflects that as a change, and if you copy or drag a cell down to another row then it gives run-time error"13" mismatch

Do you actually have a problem or situation of your own that you are trying to apply this to?
Are you just playing around and found that video and just want to try exactly what they are showing yourself?

If the first thing, then totally forget everything you saw in that video, and show me exactly the data you are working with, and explain exactly how you want this to work, or we can create the code you need (rather than try to edit someone else's example that might not match your set up or do exactly what you want). I do not like to try to debug other people's problematic code. I would rather create my own.

If you just have questions about that particular video, your best bet would probably be to reach out to that person.

 

[Logit]

The following code (paste in the ThisWorkbook module) will track any changes throughout the workbook. You must create a sheet named Tracker where the changes will be recorded.

Option Explicit

Dim vOldVal 'Must be at top of module

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

Dim bBold As Boolean


If Target.Cells.Count > 1 Then Exit Sub
'If ActiveSheet.Name = "Pricing" 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 Sheets("Tracker")
            
                If .Range("A1") = vbNullString Then
                    .Range("A1:H1") = Array("Cell Changed", "Old Value", _
                        "New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
                End If

            With .Cells(.Rows.Count, 1).End(xlUp)(2, 1)
                  .Value = ActiveSheet.Name & " : " & 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
                .Offset(0, 5) = Application.UserName
            End With
            .Cells.Columns.AutoFit
            
        End With

    vOldVal = vbNullString

    With Application
         .ScreenUpdating = True
         .EnableEvents = True
    End With
On Error GoTo 0
End Sub


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