So I am getting an error: End If without block If, I am new to VBA and have tried to apply other threads answers to my own with no luck. Can you please help me.
Thanks in advance
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("B2:B6")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "Cell " & Target.Address & " has changed."
For Each KeyCells In Range(Target.Address)
If KeyCells.Value <> "" Then KeyCells.Value = KeyCells.Value & "-CN"
Next
End If
End Sub
To ensure this fires only once you need to turn off Events inside the code, since the code itself makes a change to the cell, which again fires the exact event you are working with.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("B2:B6")
If Not Application.Intersect(KeyCells, Target) _
Is Nothing Then 'since Target is range it will suffice here
MsgBox "Cell " & Target.Address & " has changed."
Application.EnableEvents = False 'turn off events to avoid endless loop
For Each KeyCells In Range(Target.Address)
If KeyCells.Value <> "" Then KeyCells.Value = KeyCells.Value & "-CN"
Next
Application.EnableEvents = True 'turn back on so events continue to fire
End If
End Sub
Related
I wrote code to extract data from the URL a particular page.
First time I run the code it extracts data from URL to cell C1.
I am at a point where I want to display a MsgBox whenever cell value changes.
For example:
First time I run the code "Happy" gets extracted to cell C1.
(Cell value changes, so msgbox "value changed")
The second time I run the code then Also "Happy" gets extracted to the cell C1.
(means no change, Noting happens)
The third time I run the code and "Sad" gets extracted to cell C1,
so at this point, I want a msgbox of the cell change.
I tried the below code but it shows the msgbox even when same values are changed in the cell.
For example - Cell contains text "Happy". I rewrite "Happy" in cell and press enter, so it displays msgbox of cell changed despite being same text in the cell.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("A1:C10")
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
' Display a message when one of the designated cells has been
' changed.
' Place your code here.
MsgBox "Cell " & Target.Address & " has changed."
End If
End Sub
This uses Undo to check what the previous value of the cell was, and then compare it to the new value.
This will also not be case-sensitive, so HAPPY = HAPpy. If you want it to be case sensitive then remove the strconv functions.
Note that (any) of these procedures (including yours) will not react properly to multiple cells changing at once (like pasting in a range of cells), but you could add code to handle that however you needed to as demonstrated in the commented out lines.
But for single cells, this will do the trick:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range, vNew, vOld
If Target.Cells.Count > 1 Then
MsgBox ("multiple cells changed: " & vbLf & Target.Address)
'to handle multiple cells changing at omce you'll need to loop like:
' dim c as cell
' for each c in Target.Cells
' ... etc
Exit Sub
End If
Set KeyCells = Range("A1:C10") ' cells to watch
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
vNew = Target.Value
Application.EnableEvents = False
Application.Undo
vOld = Target.Value
Target.Value = vNew
Application.EnableEvents = True
'make sure value is different (NOT case sensitive)
If StrConv(vNew, vbLowerCase) <> StrConv(vOld, vbLowerCase) Then
'do something here
MsgBox "Cell " & Target.Address & " changed" & vblf & _
"From: " & vOld & vblf & _
"To: " & vNew
End If
End If
End Sub
More Information:
MSDN : Application.Undo Method (Excel)
MSDN : Application.EnableEvents Property (Excel)
MSDN : Worksheet.Change Event (Excel)
Stack Overflow : How do I get the old value of a changed cell in Excel VBA? (Ronnie Dickson's answer)
Replace:
If Not Application.Intersect(KeyCells, Range(Target.Address))
with:
If Not Application.Intersect(KeyCells, Target)
Try it like this:
Public PrevValue
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Value <> PrevValue Then
MsgBox ("value changed")
PrevValue = Target.Value
End If
End Sub
The previous value is now stored in the global variable. When the value changes, it first checks if the value is the same as the previous value.
Edit:
If you change different cells each time, you can also use
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
PrevValue = Target.Value
End Sub
To set the value of the currenctly selected cell before the change.
I have a VBA code to capitalize most of my worksheet but when I delete or clear the contents I get the debug message.
Any help would be appreciated!
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:Z")) Is Nothing Then
Target.Value = UCase(Application.Substitute(Target.Value, " ", ""))
End If
Application.EnableEvents = True
End Sub
If you delete/change/add more than a single cell then Target is more than one cell and you cannot make the value uppercase as you are doing. Loop through the intersection of Target and columns A:Z and make each uppercase.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("A:Z")) Is Nothing Then
dim rng as range
for each rng in Intersect(Target, Range("A:Z"))
rng.Value = UCase(Replace(rng.Value, chr(32), vbnullstring))
next rng
End If
Application.EnableEvents = True
End Sub
I am trying to get a macro to auto run to:
insert a blank row in each section e.g. Architectural when the data validation row above (in column A) has a value entered into it.
I entered the code as a sub in the worksheet, when I click run in the developer tab in excel, it inserts a line once, but I would like it to run automatically (after the workbook is opened) every time something is entered into column A.
Sub BlankLine()
'Updateby20150203
Dim Rng As Range
Dim WorkRng As Range
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Set WorkRng = WorkRng.Columns(1)
xLastRow = WorkRng.Rows.count
Application.ScreenUpdating = False
For xRowIndex = xLastRow To 1 Step -1
Set Rng = Range("B" & xRowIndex)
If Rng.Value = "" = False Then
Rng.Offset(1, 0).EntireRow.Insert Shift:=xlDown
End If
Next
Application.ScreenUpdating = True
End Sub
I think I can help you with your first question.
You can automatically start a macro when a cell changes with a Sub Worksheet_Change(ByVal Target As Range) Sub inside the worksheet.
Here is description: https://support.microsoft.com/en-us/help/213612/how-to-run-a-macro-when-certain-cells-change-in-excel
You can insert a new row with the following code:
Application.Selection.EntireRow.Insert shift:=xlDown
When you do just that, you will encounter that the new line will again trigger the event to start the macro, hence again inserting a new line. This leads to an infinity loop. To stop this from happening, we need to disable events for the time of the change.
Application.EnableEvents = False
Call new_line_below_selection_macro
Application.EnableEvents = True
Here is a question with a similar problem: How to end infinite "change" loop in VBA
I hope this helps.
Here is the code which should go into the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("A1:C10") 'Area this should apply
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Application.EnableEvents = False
'either you put your code here
'Application.Selection.EntireRow.Insert shift:=xlDown
'or you call it from a module
Call Module1.BlankLine
Application.EnableEvents = True
End If
End Sub
I used to have the following code and it used to work but for some reason it no longer works.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim test As Range
Dim KeyCells As Range
Dim i As String
Set KeyCells = Range("AF3:AF5000")
test = Target.Rows.Count
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
For i = Target.Row To (Target.Row + (Target.Rows.Count - 1))
If Not ActiveSheet.Cells(i, 32) = "" Then
ActiveSheet.Cells(i, 20).Value = "Closed"
End If
Next
End If
End sub
Basically if there is data in any cells of column AF then the cell align with the information in column T would mark Closed. For example if AF65 <>"" then T65.value ="Closed"
Any idea why it no longer works or if there is another possibility for a macro?
Get rid of the redundant code and non-specific worksheet references. For example, a Worksheet_Change can be triggered when that worksheet is not the Activesheet; putting in Activesheet when it is not required only confuses the issue.
You also are not disabling events so your sub is going to try to run on top of itself.
This should be closer to what you are attempting to perform.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim trgt As Range
For Each trgt In Intersect(Target, Range("AF3:AF5000"), Target.Parent.UsedRange)
If CBool(Len(trgt.Value2)) Then
trgt.Offset(0, -12) = "Closed"
Else
trgt.Offset(0, -12) = vbNullString
End If
Next trgt
End If
safe_exit:
Application.EnableEvents = True
End Sub
If your original sub just 'stopped working' then put Application.EnableEvents = True into the VBE's Immediate window and tap [enter]. It is possible that your earlier code crashed with event handling disabled.
So I want a message to appear when a cell changes that notifies somebody when the cell is changed. The cells that change are referenced from cells in another workbook. Here is my code so far, but it only works when I manually change the cells. It doesn't work when I change the cell being referenced.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("B2:P43")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Beep
MsgBox "Cell " & Target.Address & "has changed."
End If
End Sub
Try fully qualifying the Ranges, like this:
Set KeyCells = Sheet1.Range("B2:P43")