Hello Newbie here
Hello Newbie here
Hello Imlooking4sum1lyku,
Welcome to Excelforum. Be a part of large Excel community. Enjoy Learning.
If I have helped, Don't forget to add to my reputation (click on the star below the post)
Don't forget to mark threads as "Solved" (Thread Tools->Mark thread as Solved)
Use code tags when posting your VBA code: [code] Your code here [/code]
Yup. Ive learned a lot in this forum since I used the VBA but now I need some help regards on my post. Below is the code which tracked all the changes in every sheets. My problem now is how to exclude some sheets from tracking? Any help will be much appreciated. Thank you in advance.
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim wSheet As Worksheet
Dim wActSheet As Worksheet
Dim iCol As Integer
Set wActSheet = ActiveSheet
Dim NameOfWorkbook
Dim pw2 As String
pw2 = ""
If vOldValue = "" Then
ElseIf vOldValue <> "" Then
End If
'Continue
On Error Resume Next ' This Error-Resume-Next is only to allow the creation of the tracker sheet (10. History (Back-up)).
Set wSheet = Sheets("10. History (Back-up)")
If wSheet Is Nothing Then
Set wActSheet = ActiveSheet
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "10. History (Back-up)"
End If
On Error GoTo 0
'**** End of specific error resume next
On Error GoTo ErrorHandler
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
With Sheets("10. History (Back-up)")
If .Cells(1, 1) = "" Then '
iCol = 1 '
Else '
iCol = .Cells(1, 256).End(xlToLeft).Column - 7 '
If Not .Cells(65536, iCol) = "" Then '
iCol = .Cells(1, 256).End(xlToLeft).Column + 1 '
End If '
End If '
'********* END *****************************************************************************'
.Unprotect Password:=pw2
'******** Sets the Column Headers **********************************************************
If LenB(.Cells(1, iCol).Value) = 0 Then
.Range(.Cells(1, iCol), .Cells(1, iCol + 7)) = Array("Cell Changed", "Old Value", _
"New Value", "Old Formula", "New Formula", "Time of Change", "Date of Change", "User")
'Auto-setup
.Cells.Columns.AutoFit
End If
With .Cells(.Rows.Count, iCol).End(xlUp).Offset(1)
'Column A (Cell Changed)
'Getting the current Name of File (w/o extension) as it changes.
NameOfWorkbook = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1))
'sOldAddress = NameOfWorkbook + Active Sheet Name; while #8 is to subtract the remaining excess
.Value = Right(sOldAddress, Len(sOldAddress) - Len(NameOfWorkbook) - 8)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
.WrapText = True
'Column B (Old Value)
.Offset(0, 1).Value = vOldValue
.Offset(0, 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 1).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 1).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 1).HorizontalAlignment = xlLeft
.Offset(0, 1).VerticalAlignment = xlTop
.Offset(0, 1).WrapText = True
'Column D (Old Formula)
.Offset(0, 3).Value = sOldFormula
.Offset(0, 3).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 3).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 3).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 3).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 3).HorizontalAlignment = xlLeft
.Offset(0, 3).VerticalAlignment = xlTop
.Offset(0, 3).WrapText = True
If Target.Count = 1 Then
'Column C (New Value)
.Offset(0, 2).Value = Target.Value
.Offset(0, 2).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 2).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 2).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 2).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 2).HorizontalAlignment = xlLeft
.Offset(0, 2).VerticalAlignment = xlTop
.Offset(0, 2).WrapText = True
If Target.HasFormula Then .Offset(0, 4).Value = "'" & Target.Formula
'Column E (New Formula)
.Offset(0, 4).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 4).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 4).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 4).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 4).HorizontalAlignment = xlLeft
.Offset(0, 4).VerticalAlignment = xlTop
.Offset(0, 4).WrapText = True
End If
'Column F (Time of Change)
.Offset(0, 5) = Time
.Offset(0, 5).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 5).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 5).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 5).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 5).HorizontalAlignment = xlCenter
.Offset(0, 5).VerticalAlignment = xlTop
.Offset(0, 5).WrapText = True
'Column G (Date of Change)
.Offset(0, 6) = Date
.Offset(0, 6).NumberFormat = "[$-409]mmm. dd, yyyy;@"
.Offset(0, 6).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 6).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 6).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 6).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 6).HorizontalAlignment = xlCenter
.Offset(0, 6).VerticalAlignment = xlTop
.Offset(0, 6).WrapText = True
'Column H (User)
.Offset(0, 7) = Application.UserName
.Offset(0, 7).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Offset(0, 7).Borders(xlEdgeRight).LineStyle = xlContinuous
.Offset(0, 7).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Offset(0, 7).Borders(xlEdgeTop).LineStyle = xlContinuous
.Offset(0, 7).HorizontalAlignment = xlLeft
.Offset(0, 7).VerticalAlignment = xlTop
.Offset(0, 7).WrapText = True
End With
.Protect Password:=pw2
End With
ErrorExit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
wActSheet.Activate
Exit Sub
ErrorHandler:
Resume ErrorExit
End Sub
Last edited by Imlooking4sum1lyku; 09-19-2017 at 10:55 PM.
Hello Imlooking4sum1lyku and Welcome to Excel Forum.
You have posted a question in a forum that is set up for introductions. In order to get assistance you'll need to post the question on either the VBA or General forum. I would suggest that you also attach a sample of the workbook by clicking on the GO ADVANCED button below the Quick Reply window and then scrolling down to Manage Attachments to open the upload window. Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Remember to desensitize the data.
Let us know if you have any questions.
Consider taking the time to add to the reputation of everybody that has taken the time to respond to your query.
Hello JeteMc,
Sorry, how to go to VBA or General Forum?
Ok, ill follow your suggestion. ty
Last edited by Imlooking4sum1lyku; 09-21-2017 at 10:38 PM.
Here is a link to the 'Forums' page. You can also get there by scrolling to the top of this page and selecting the 'Forums' button which is on the left side of the ribbon, above 'New Posts' and to the left of 'What's New'.
Let us know if you have any questions.
how to sum wit unit like 1.5kg+2.5kg=4kg
Use a calculator
But honestly: please read JeteMc post above https://www.excelforum.com/hello-int...ml#post4746882 . And do read and follow this forum rules https://www.excelforum.com/forum-rul...rum-rules.html (during registration you declared you will).
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks