I'm working on an excel macro that when a part number is scanned into the spreadsheet (in column A), it will automatically open up a PDF document related to that part number. I've got it working for the first cell I want to look at, but am stuck after that. I can add a bunch of "if" statements but there has to be a way to clean it up rather than having hundreds of "if" statements. I need to start in cell A9 and continue to cell A209. Below is what I have so far. Any help in combining these into a simpler code would be greatly appreciated. Thanks in advance!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
If Target.Address = "$A$9" Then
varCellvalue = Range("A9").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
If Target.Address = "$A$10" Then
varCellvalue = Range("A10").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
If Target.Address = "$A$11" Then
varCellvalue = Range("A11").Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
This could go on and on, but I figured there has to be a more efficient way of combining these into a simple statement.
With your code, all you need is something quite simple and short (see code below)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
' run your code only if a cell inside the Range("A9:A11") has been changed
If Not Intersect(Target, Range("A9:A11")) Is Nothing Then
varCellvalue = Target.Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
End If
End Sub
You could use a Select Case instead
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
Select Case Target.Address
Case "$A$9"
varCellvalue = Range("A9")
Case "$A$10"
varCellvalue = Range("A10")
Case "$A$11"
varCellvalue = Range("A11")
End Select
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & varCellvalue & "\" & varCellvalue & " Pack.pdf"
Or you could do it faster since you are just inserting the value of the Target into the url.
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & Target & "\" & Target & " Pack.pdf"
If you need to limit this to a few cells, and not every range, then you can use an array to load the target cells, and just check if the target address is in there, then run your code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim varCellvalue As String
Dim targetCells() As Variant
targetCells() = Array("$A$9", "$A$10", "$A$11")
If (UBound(Filter(targetCells, Target.Address)) > -1) Then
'This cell is in your array
Debug.Print Target.Value
ThisWorkbook.FollowHyperlink "F:\ITEM PART MASTER\" & Target.Value & "\" & Target.Value & " Pack.pdf"
End If
End Sub
Related
I currently have code that logs any changes made into a separate change log sheet. I need to add in code that takes the user to that newest entry in the change log so that they have to put in a note for why they changed it. I was exploring this option of being taken to that entry or having a pop-up text box that appears when a change is made prompting the user to type in a note that will then be saved with that entry in the log.
Here's my working code:
Dim oldValue As String
Dim oldAddress As String
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
Data = "Data"
Dim ssSheetName As String
MoreData = "MoreData"
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
If ActiveSheet.Name = Data Then
Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & Data & "'!" & oldAddress, TextToDisplay:=oldAddress
ElseIf ActiveSheet.Name = MoreData Then
Sheets("LogDetails").Hyperlinks.Add Anchor:=Sheets("LogDetails").Range("A" & Rows.Count).End(xlUp).Offset(0, 5), Address:="", SubAddress:="'" & MoreData & "'!" & oldAddress, TextToDisplay:=oldAddress
End If
Sheets("LogDetails").Columns("A:D").AutoFit
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Count = 1 Then
oldValue = Target.Value
End If
oldAddress = Target.Address
End Sub
I couldn't resist to do a bit of refactoring:
It's always a good idea to create a seperate sub-routine for a work like this - and then call the routine from the worksheet_change-event.
Furthermore I am first creating an array with the values to log - and then write this array to the log-sheet. Usually this is for performance reasons - which is not the case for this logging.
But as you can see: it is much easier to read and understand the code - as the reader doesn't have to "walk" along the long code line to see what is happening.
By using a variable for the target range it is pretty easy to select it later.
Regarding your basic question:
This code first asks the user for the comment with a input-box. If he/she doesn't give an answer, according cell will be highlighted and user again asked to put in a comment.
Put this into a normal module
Public Sub addLogEntry(rgCellChanged As Range, oldValue As String, oldAddress As String)
Dim wsChanged As Worksheet
Set wsChanged = rgCellChanged.Parent
Dim wsLogData As Worksheet
Set wsLogData = ThisWorkbook.Worksheets("LogDetails")
'we don't need logging on the logsheet
If wsChanged Is wsLogData Then Exit Sub
'Get comment from user
Dim commentChange As String
commentChange = InputBox("Please enter a comment, why you made this change.", "Logging")
Application.EnableEvents = False
'Collect data to log
Dim arrLogData(6) As Variant
arrLogData(0) = wsChanged.Name & " - " & rgCellChanged.Address(0, 0)
arrLogData(1) = oldValue
arrLogData(2) = rgCellChanged.Value
arrLogData(3) = Environ("username")
arrLogData(4) = Now
arrLogData(6) = commentChange '>>> adjust the column in case your comment column is not G
'get cell to enter log data
Dim rgLogData As Range
Set rgLogData = wsLogData.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
'write data
rgLogData.Resize(, 7).Value = arrLogData
'create hyperlink
wsLogData.Hyperlinks.Add rgLogData.Offset(, 5), Address:="", SubAddress:="'" & wsChanged.Name & "'!" & oldAddress, TextToDisplay:=oldAddress
'>>> optional: activate log sheet and select comment cell
'If user hasn't entered a comment, activate logsheet and cell
If LenB(commentChange) = 0 Then
wsLogData.Activate
MsgBox "Please enter the comment, why you made the change.", vbExclamation, "Logging"
rgLogData.Offset(, 6).Select
End If
Application.EnableEvents = True
End Sub
And this is how your worksheet_change looks like
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
addLogEntry Target, oldValue, oldAddress
End Sub
Another advantage: if a code reader gets to this he/she immediately understands what will happen (a log entry will be added) - it is not necessary to read the whole code to understand it
What are options to monitor changes in an Excel table?
Possible solution I can think of is to have a clone copy of the table, say in a hidden worksheet and a formula which compares both sheets.
Is there any other way?
Well, there are multiple ways.
On way would be to subscribe to Worksheet_Change event with such method:
Private Sub Worksheet_Change(ByVal Target As Range)
'some code, which will compare values and store info in a file
End Sub
I suggested also way of logging such event: take user name and what has changed and write this info to a file.
Also, you'd need to do some extra coding to see if this is the change you are interested in, but this is left for you to discover, as it is to broad to describe all the options here :)
I've come up with a code (as an event based code - Worksheet_Change) like this:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rg As Range
Set rg = Cells
Dim lastrow As Long
Dim username As String
If Intersect(Target, rg) Is Nothing Then Exit Sub
On Error GoTo ExitHere
Application.EnableEvents = False
With SomeOtherSheet
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
.Range("H" & lastrow + 1) = Now
.Range("I" & lastrow + 1) = Target.Address
.Range("J" & lastrow + 1) = Environ("Username")
.Range("K" & lastrow + 1) = Application.username
End With
ExitHere:
Application.EnableEvents = True
End Sub
It records any change made by a user in the given Sheet (the one where the code is written). It will show me in another Sheet who, when and where the change was done. The only problem I have with this matter is that the user has to enable macros, otherwise it doesn't work... I don't know how to reasonably solve this issue...
I totally agree with #Michał Turczyn. For security reasons is better to keep records about the changes. You could use:
Option Explicit
Dim OldValue As String
Private Sub Worksheet_Change(ByVal Target As Range)
MsgBox "The old value was " & OldValue & "." & vbNewLine & _
"The new value is " & Target.Value & "." & vbNewLine & _
"Date of change " & Now & "." & vbNewLine & _
"Change by " & Environ$("computername") & "."
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
OldValue = Target.Value
End Sub
I have a worksheet (sheet1) which contains a cell A1 with formula ='sheet2'!D10. I would like to run a macro each time cell A1 in sheet1 changes (as a result of a change in D10 in sheet2). sheet2 is streaming financial data.
Because it is a change in value, Worksheet_Change does not trigger an event. I also can't seem to find a solution with Worksheet_Calculate.
In my research, the closest solution I could find was offered here, but I have not been able to successfully implement it.
You are going to have to use Worksheet_Calculate. It's unclear on whether the 'streaming' will trigger a Worksheet_Calculate in Sheet2 but the linked cell in Sheet1 will definitely trigger a Worksheet_Calculate in that worksheet's private code sheet providing you have calculation set to automatic.
You need a variable that will hold previous values of Sheet1!A1 that can be compared to the current value of Sheet1!A1. Some prefer to use a public var declared in a public module's declaration area; I prefer to use a static var within Sheet1's Worksheet_Calculate itself.
From Microsoft Docs,
Normally, a local variable in a procedure ceases to exist as soon as the procedure stops. A static variable continues to exist and retains its most recent value. The next time your code calls the procedure, the variable is not reinitialized, and it still holds the latest value that you assigned to it. A static variable continues to exist for the lifetime of the class or module that it is defined in.
The first issue is seeding the static variable for its first use. A variant-type variable that has never been given a value report True when tested with IsEmpty so when the workbook is first opened, the first calculation cycle will simply record the value of Sheet1!A1 into the static var. Any future calculation cycle will compare the value in Sheet1!A1 to the value held in the static var and if they are different, the external sub procedure ('... run a macro ...' according to your question's narrative) will be run and the new value of Sheet1!A1 will be stored in the static var. In this way, any change in the value returned by the formula in Sheet1!A1 will force a calculation cycle, hence the worksheet's Worksheet_Calculate event sub procedure which will in turn run your external sub procedure.
In Sheet1's private code sheet
Option Explicit
Private Sub Worksheet_Calculate()
Static s2d10 As Variant
If IsEmpty(s2d10) Then
'load static var with expected value
s2d10 = Cells(1, "A").Value2
ElseIf s2d10 <> Cells(1, "A").Value2 Then
'run sub procedure here
'... run a macro ...'
'load A1's current value into the static var
s2d10 = Cells(1, "A").Value2
End If
End Sub
Selection_Change & Change
I went into a different direction and got lost. I think there might be some useful stuff in here, so here's the code anyway. It could be working in most conditions, just lose the 'str1' lines.
The 'str1' lines are for debugging purposes and show the behavior of the cells at different conditions.
Not sure if the sub ChangeD10 is emulating your conditions.
Throwing in the towel, but would appreciate any pinpointing of errors in the code.
Option Explicit
Private TargetValue As Variant
Private TargetAddress As String
Private Sub Worksheet_Change(ByVal Target As Range)
'The Playground
Const cStrWs1 As String = "Sheet1"
Const cStrWs2 As String = "Sheet2"
Const cStrCell1 As String = "A1"
Const cStrCell2 As String = "D10"
'Other Variables
Dim oWs1 As Worksheet
Dim oWs2 As Worksheet
Dim oRng As Range
Dim varA1_Before As Variant
Dim varA1_Now As Variant
'Debug
Const r1 As String = vbCr
Dim str1 As String
'Initialize
Set oWs1 = ThisWorkbook.Worksheets(cStrWs1)
Set oWs2 = ThisWorkbook.Worksheets(cStrWs2)
Set oRng = oWs2.Range(cStrCell2)
varA1_Before = oWs1.Range(cStrCell1).Value
str1 = "Worksheet_Change"
'Play
If Target.Address = oRng.Address Then
If Target.Value <> TargetValue Then
varA1_Now = oWs2.Range(cStrCell2).Value
oWs1.Range(cStrCell1).Value = varA1_Now
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 & "' changed " _
& "(Target.Value <> TargetValue)" & r1 & Space(2) _
& "Before: TargetValue (" & TargetAddress & ") = '" _
& TargetValue & "'," & r1 _
& " varA1_Before (" & Range(cStrCell1).Address _
& ") = " & varA1_Before & "'," & r1 & Space(2) _
& "Now: Target.Value (" & Target.Address & ") = '" _
& Target.Value & "'," & r1 _
& " varA1_Now (" & Range(cStrCell1).Address _
& ") = " & varA1_Now & "'."
Else
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 _
& "' didn't change. TargetValue = '" & TargetValue _
& "' and Target.Value = '" & Target.Value & "'."
End If
Else
str1 = str1 & r1 & Space(1) & "Cell '" & cStrCell2 _
& "' not changed. The Target.Address is '" _
& Target.Address & "', TargetValue is '" & TargetValue _
& "' and Target.Value is '" & Target.Value & "'."
End If
Debug.Print str1
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const r1 As String = vbCr
Dim str1 As String
str1 = "Worksheet_SelectionChange"
If Target.Cells.Count = 1 Then
str1 = str1 & r1 & Space(1) & "Cell '" & Target.Address _
& "' selected " & r1 & Space(2) _
& "Before: TargetValue (" & TargetAddress & ") = '" _
& TargetValue & "'," & r1 & Space(2) _
& "Now: Target.Value (" & Target.Address & ") = '" _
& Target.Value & "'."
TargetValue = Target.Value
TargetAddress = Target.Address
Else
str1 = str1 & r1 & Space(1) & "Multiple cells in range '" _
& Target.Address & "'."
End If
Debug.Print str1
End Sub
Sub ChangeD10()
ThisWorkbook.Worksheets("Sheet2").Cells(10, 4) = 22
End Sub
I am looking for a function to print in a comment box, who was the users that changed the data from that cell. What I have for now is this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Application.EnableEvents = False
Range("B" & Target.Row) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
It "triggers" automatically when someone types something in a cell.
And is printing only the last user name that changed the data, but I want to be some kind of a log, to print all the users. Do you think it is possible?
One way is, insert a New Sheet and name it "Log" and place the two headers like this...
On Log Sheet
A1 --> Date/Time
B1 --> User
Now replace your existing code with this...
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
Dim wsLog As Worksheet
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Set wsLog = Sheets("Log")
Application.EnableEvents = False
Range("B" & Target.Row) = Now
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
So each time any user makes changes in the target range, the time of change and the user name will be listed on Log Sheet.
Edit:
As per the new setup, these column headers should be there on the Log Sheet.
A1 --> Date/Time
B1 --> User
C1 --> Cell
D1 --> Old Value
E1 --> New Value
Then replace the existing code with the following two codes...
Dim oVal
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Range("A" & Target.Row).Value = "" Then GoTo EndeSub
Dim wsLog As Worksheet
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
On Error GoTo EndeSub
Set wsLog = Sheets("Log")
Application.EnableEvents = False
Range("B" & Target.Row) = Now
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 1) = Environ("UserName")
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 2) = Target.Address(0, 0)
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 3) = oVal
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1, 4) = Target.Value
wsLog.Range("A" & Rows.Count).End(xlUp).Offset(1) = Now
End If
EndeSub:
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
If Not Intersect(Range("C:JA"), Target) Is Nothing Then
oVal = Target
End If
End Sub
In a Public Module
Sub LogChange(Target As Range)
Dim cell As Range, vNew As Variant, vOld As Variant
vNew = Target.value
Application.Undo
vOld = Target.value
Target.value = vNew
With getLogWorksheet
With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
' Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
.Resize(1, 6).value = Array(Now, Environ("UserName"), Target.Parent.Name, Target.Address(False, False), vOld, vNew)
End With
End With
End Sub
Private Function getLogWorksheet() As Workbook
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets("Log")
On Error GoTo 0
If ws Is Nothing Then
Set ws = ThisWorkbook.Worksheets.Add
ws.Visible = xlSheetVeryHidden
ws.Name = "Log"
ws.Range("A1").Resize(1, 6).value = Array("Date/Time", "UserName", "Worksheet", "Address", "Old Value", "New Value")
End If
End Function
In a Worksheet Module
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.CountLarge > 1 Then
Application.Undo
MsgBox "Changing more than 1 cell at a time is prohibited", vbCritical, "Action Undone"
ElseIf Not Intersect(Range("C:JA"), Target) Is Nothing Then
LogChange Target
End If
End Sub
Another bit of code to give you some ideas:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
val_before = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then
MsgBox Target.Count & " cells were changed!"
Exit Sub
End If
If Target.Comment Is Nothing Then
Target.AddComment
existingcomment = ""
Else
existingcomment = Target.Comment.Text & vbLf & vbLf
End If
Target.Comment.Text Text:=Format(Now(), "yyyy-mm-dd") & ":" & vbLf & Environ$("Username") & _
" changed " & Target.Address & " from:" & vbLf & """" & val_before & _
"""" & vbLf & "to:" & vblkf & """" & Target.Value & """"
End Sub
Any time a cell is selected, it stores the cell's existing value in a variable. If the cell is changed, it creates a new comment in the cell (or appends the existing comment if there is one) with the date, username, cell address, and the "before and after" values. This could be super annoying if someone's trying to make a lot of changes, and if there are multiple changes at once, then it will just warn you without creating a comment. I'd suggest you practice on a blank workbook (or a 2nd copy of the one you're working on) in case there are any problems. Be sure to Google any of the properties/methods than you are unfamiliar with, for the sake of learning, and for building a solution to fit your needs!
I have quite big excel with user forms and a lot of VBA going on. I have a problem with locking partially one worksheet and in the same time allowing VBA to track changes.
At the moment I track changes using the code below - this code is sitting under Microsoft Excel Objects >> Sheet1:
Option Explicit
Public preValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) `& "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ`("UserName")
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then
preValue = "a blank"
Else: preValue = Target.Value
End If
End Sub
And another bit of code is sitting in the folder Forms ( where I created user form to pick up some details from users) and looks like that:
Dim myPassword As String
myPassword = "123"
Set wsUK = Worksheets("Sheet1")
wsUK.Unprotect Password:=myPassword
' here there is a lot of code that throws data into Sheet1
wsUK.Protect Password:=myPassword
The problem is that after the user form finished Sheet1 is partially protected, but I still allow users to change data in column H and P. When I try to do it I get Run-time error '1004' The cell or chart that you are trying to change is protected and therefore read-only.
Don't use the sheet protect method, but still prevent users from changing the cells you want protected.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 8 Or Target.Column = 16 Then
Target.ClearComments
Target.AddComment.Text Text:="Previous Value was " & preValue & Chr(10) & "Revised " & Format(Date, "mm-dd-yyyy") & Chr(10) & "By " & Environ("UserName")
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub