How to run this function in excel using vba - excel

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B12").Address Then
Application.EnableEvents = False
Dim sOldValue As String, sNewValue As String
sNewValue = Target.Value
Application.Undo
Dim rOld As Range
Set rOld = Range("A1:E1").Value
Target.Value = sNewValue
Range("A15:E15").Value = rOld.Value
Application.EnableEvents = True
End If
End Sub
How to run this function, can you please call this function?

Create a button, add in the following code, you might need to change your code from Private to Public
`Private Sub CommandButton1_Click()
Call Worksheet_Change
End Sub`

The code you posted is for the Worksheet.Change event. The event occurs when cells on the worksheet are changed by the user or by an external link.
All you need to run this sub is to place the code in the sheet module for the relevant sheet and change B12 cell.

A Worksheet Change: Change Range Values on Cell Change
Worksheet_ in the signature Private Sub Worksheet_Change(ByVal Target As Range) indicates that this procedure belongs in the sheet module, e.g. Sheet1, of the worksheet where you want it applied (not in the ThisWorkbook module nor in a standard module, e.g. Module1). Such a procedure will run automatically (get triggered) when an event occurs, particularly for this procedure, after a manual change has happened in a range i.e. after
you write something into the formula bar and press enter,
you (copy) paste values to a range, or
you use VBA to write values to a range.
In this procedure, if you want to write something to a range of the worksheet, to not retrigger the event and possibly end up with an endless loop ('crashing' Excel), you will disable events before you start writing, and enable them after writing as you did in your code. If an error occurs between these two lines, the events will stay disabled and the code won't trigger until they are enabled again.
To check if events are enabled you could use the line Debug.Print Application.EnableEvents in another procedure or in the Immediate window just use ?Application.EnableEvents and press enter. Similarly, if the answer is False, in the Immediate window, you can use Application.EnableEvents = True and press enter to enable events.
The line Set rOld = Range("A1:E1").Value is wrong and results in
Run-time error '424': Object required
To avoid the error you could use one of the following:
Dim rgOld As Range: Set rgOld = Range("A1:E1")
Range("A15:E15").Value = rgOld.Value
Target.Value = sNewValue
Dim OldValues() As Variant: OldValues = Range("A1:E1").Value
Range("A15:E15").Value = OldValues ' or after the following line
Target.Value = sNewValue
Range("A15:E15").Value = Range("A1:E1").Value
Target.Value = sNewValue
Basically, you want to write the data before rewriting the new value. Optionally, in the second case where the data is written to an array (OldValues), you can write the values afterward.
Since the use of an additional variable is kind of redundant in the first two cases, the last (the simplest, the most straightforward) case is used in the following code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
Application.EnableEvents = True
End Sub
If you want to modify (experiment with) the code, you should introduce some error handling so you don't end up with events disabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error'" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub

One thing is basic: how did you create this function? Did you open the Excel VBA editor, select a sheet and chose the corresponding event, like I did in the following screenshot:
As you see, the macro is linked to "Sheet1", it is linked to the events of the "Worksheet" itself, and it is triggered by any "Change" of that worksheet.

Related

Error Message when changing value of particular cell and restore previous value VBA

I am trying to create a code using vba whereby I want to make a certain cell B2 read-only and unchangeable when session is unlocked (I have a lock and unlock module for later whereby locked disallow editing and unlocked allows editing).
The code aims to give an error message and restore the cell to the previous value before edits are made when session is locked.
Problem: However, currently the results from this code successfully gave an error message when edit is done when locked BUT made the cell blank after the error message when I actually want it to restore to the previous value before edit was made
Please help if you know what went wrong and thank you in advance
Public locked As Boolean
Dim oldValue As Variant
Private Sub worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target.Value
End Sub
Private Sub worksheet_Change(ByVal Target As Range)
If Target.Row = 2 And Target.Column = 2 Then
If locked Then
If Target.Value <> oldValue Then
Target.Value = oldValue
MsgBox "You are not allowed to edit!"
End If
End If
End If
End Sub
An Events Duo: Change and SelectionChange
In the Worksheet_SelectionChange event you can safely use Target because you can select only one cell at a time.
In the Worksheet_Change event you could have copied hundreds of cells which are the cells Target is referring to. But you are only interested in one cell, so use intersect and use a variable to get this single cell and do the operations necessary on it. Also, to avoid an endless loop by constantly retriggering the event, disable events before writing to the worksheet but don't forget to enable them immediately after writing.
Option Explicit
' If you're using the variables outside of this module, they need
' to be declared as 'Public'. Otherwise, use 'Private' ('Dim' is the same
' but it's kind of reserved for inside procedures).
Public Locked As Boolean
Private Const CellAddress As String = "B2"
Private OldValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Range(CellAddress), Target) Is Nothing Then
OldValue = Target.Value
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCell As Range: Set iCell = Intersect(Range(CellAddress), Target)
If Not iCell Is Nothing Then
If Locked Then
If StrComp(CStr(iCell.Value), CStr(OldValue), vbTextCompare) _
<> 0 Then
Application.EnableEvents = False ' prevent retriggering
iCell.Value = OldValue
Application.EnableEvents = True
MsgBox "You are not allowed to edit!"
End If
End If
End If
End Sub

Should I better modify some codes for .ClearContents?

I have simple macros for clearing cells on "Sheet1", which have drop down lists.
Sub reset1()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
Range("D6:E7").ClearContents
End Sub
Sub reset2()
Range("D20:E21").ClearContents
Range("D8:E9").ClearContents
End Sub
Then I call these macros on "Sheet1" if the cell values change
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$4" Then
Call reset1
End If
If Target.Address = "$D$6" Then
Call reset2
End If
End Sub
This code is written on the "Sheet1".
Normally it works but sometimes reset1() doesn't work.
I should then save and reopen the excel or run the macro manually.
Should I better modify some codes?
First problem is that with Range("D20:E21") it is not clear in which worksheet that range should be. Always specify the worksheet like Worksheets("Sheet1").Range("D20:E21").
Second problem is that if you .ClearContents in a Worksheet_Change event this is a cell change and triggers another Worksheet_Change event and so on. So it is recommended to disable events Application.EnableEvents = False before changing cells in Worksheet_Change event.
Third problem is that if you test Target.Address = "$D$4" and you copy paste a range where D4 is included your code will not run even if your cell D4 changed. Therefore you always need to work with Intersect.
Option Explicit
Sub Reset1(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9,D6:E7").ClearContents
' alternative:
' Union(ws.Range("D20:E21"), ws.Range("D8:E9"), ws.Range("D6:E7")).ClearContents
End Sub
Sub Reset2(ByVal ws As Worksheet)
ws.Range("D20:E21,D8:E9").ClearContents
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS ' in any case an error happens make sure events are enabeld again
If Not Intersect(Target, Me.Range("D4")) Is Nothing Then
Reset1 Me ' here we tell Reset1 to take `Me` as worksheet. Me refers to the worksheet `Target` is in.
End If
If Not Intersect(Target, Me.Range("D6")) Is Nothing Then
Reset2 Me
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number Then
Err.Raise Err.Number
End If
End Sub

Use named range to trigger Worksheet_Change event causes 1004 error

I have an excel workbook and I am running some code to remove extra spaces from one cell in several sheets. When I enter something in cell "E4", it removes every instance of " " and replaces it with "". This works as anticipated.
I am trying to get this to work for more than one sheet, by using named ranges. In the sheets, I created a named range "ConfigurationInput" with a scope of sheet.
The following code is in one of the sheets, and it functions as expected:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("E4")) Is Nothing Then
Call RemoveSpaces(Range("E4"))
End If
End Sub
This calls the following Sub, located in a module:
Sub RemoveSpaces(RngRemove)
Dim rng As Range
Set rng = RngRemove
rng = WorksheetFunction.Substitute(rng, " ", "")
End Sub
I am trying to replace "E4" with the named range "ConfigurationInput", and I am receiving the following error which crashes Excel:
Does anybody have a suggestion? I tried simplifying to a single cell and using .Address but that didn't work either:
If Target.Address = Range("ConfigurationInput").Address Then
I finally figured it out:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("ConfigurationInput")) Is Nothing Then
Call FixConfig(Range("ConfigurationInput"))
End If
Application.EnableEvents = True
End Sub
I had to wrap the code with Application.EnableEvents = False and Application.EnableEvents = True

Copy paste values triggered by worksheet change event is not working

I am using worksheet change event to trigger copy paste values. Worksheet change code is in the sheet2
Sub worksheet_change(ByVal Target As Range)
Application.EnableEvents = True
Set Target = Range("AB2")
If Target.Value = "OK" Then
Call myTR1
End If
Please note AB2 cell takes it's value from another sheet
Copy paste code is in a Module
Sub myTR1()
Sheets("BA1").Range("AR6:AS8").Value = Sheets("BA1").Range("AL17:AM19").Value
End Sub
When target range changes to "OK", my copy paste macro is not triggering. What am I doing wrong?
Using your eaxct code worked, although you didnt have end sub in your example?
EDIT:
Bear in mind the 'OK' is case sensitive so it will have to be in uppercase to fire, if you want it to fire either on lower or upper you can use the second code.
Sub worksheet_change(ByVal Target As Range)
Application.EnableEvents = True
Set Target = Range("AB2")
If Target.Value = "OK" Then
Call myTR1
End If
End Sub
Sub worksheet_change(ByVal Target As Range)
Application.EnableEvents = True
Set Target = Range("AB2")
If Target.Value = "OK" Or Target.Value = "ok" Then
Call myTR1
End If
End Sub

Restricting the user to delete the cell contents

Is there's any way to restrict the user from deleting the cell contents without using the protect method of excel. I have this code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, Range("C21:D" & ws.Range("C" & ws.Rows.Count).End(xlUp).Row)) Is Nothing Then
Cancel = True
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
EndIf
End sub
But this only disallows the editing of the cell contents. I want make a function that would disallow the editing and deleting the data in a cell without using the protect method. Thanks!
Without lock and unlock, you can use this.
We have there one global variable to store selection value (to preserve beforechange state). Function SelectionChange, updating value of current cell, so we can restore cell value after users try.
Sub worksheet_change just controling, if user targeting specified row and column (can be adjusted for whole range), and if he try to change value, he is prompted and value is set back.
Dim prevValue As Variant
Private Sub worksheet_SelectionChange(ByVal target As Range)
prevValue = target.Value
End Sub
Private Sub worksheet_change(ByVal target As Range)
If target.Row = 5 And target.Column = 5 Then
If target.Value <> prevValue Then
target.Value = prevValue
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
End If
End If
End Sub
edit: disable editing every cell which is not empty
Private Sub worksheet_change(ByVal target As Range)
If prevValue <> "" Then
If target.Value <> prevValue Then
target.Value = prevValue
MsgBox "You are not allowed to edit!", vbCritical + vbOKOnly
End If
End If
End Sub
Try my idea. Copy and paste these codes into the module of the sheet where the protected range is located. In my case it was called "Arkusz1". The protected range is "A1:A10".
Private Sub Worksheet_Change(ByVal Target As Range)
For Each cell In Range("A1:A10")
If cell.Text <> Sheets("hidden").Cells(cell.Row, cell.Column) Then
Call Undoing
End If
Next cell
End Sub
Private Sub Undoing()
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
In the "This_worksheet" module copy and paste this code:
Private Sub Workbook_Open()
Sheets.Add
ActiveSheet.Name = "hidden"
Sheets("Arkusz1").Range("A1:A10").Copy
Sheets("hidden").Select
ActiveSheet.Paste
Sheets("hidden").Select
ActiveWindow.SelectedSheets.Visible = False
End Sub
Private Sub Workbook_Close()
Sheets("hidden").Visible = True
Sheets("hidden").Delete
End Sub
You will have to change the name of the sheet from "Arkusz1" to "Sheet1" or any other name Your sheet has got.
The idea is as follows. Upon the opening of the workbook the application creates a hidden spreadsheet into which it copies the contents of protected cells. For some technical reasons I had to hide the sheet after the copy operation, otherwise it did not work on my computer. Then, any change of the sheet "Arkusz1" triggers the event which compares the contents of the protected range with the same range in the hidden sheet.
If there are any differences the application undoes the last action of the user.
Undoing has to be done when event handling by Excel is turned off, because undoing a previous action is also an event of changing the sheet and we would cause a cascade of events - every undo operation would trigger the event "worksheet_change" and it would never stop getting activated.
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

Resources