When B21 is blank and I click on D21 cell, I get shown error 2 and error 1(this is not expected as I am expecting only error 1). But when I click on E21 cell I get shown only Error 2 which is expected.
I am not sure where am I going wrong ?
My code is below:
If [B21] = "" Then
If Target.Column = 4 Then
If Target.Row = 21 Then
Beep
Cells(Target.Row, Target.Column).Offset(0, 1).Select
MsgBox "1.Error"
End If
ElseIf Target.Column = 5 Then
If Target.Row = 21 Then
Beep
Cells(Target.Row, Target.Column).Offset(0, 1).Select
MsgBox "2.Error"
End If
End If
When your code selects a cell, that also triggers the event handler. Typically you would prevent that by setting Application.EnableEvents = False (don't forget to set it back to True later...) –
an alternative to Tim Williams's solution is a worksheet scoped variable to keep track of when E21 cell is being selected by your code itself
so your worksheet code would be:
Dim dontBeep As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [B21] = "" Then
If Target.Column = 4 Then
If Target.Row = 21 Then
Beep
dontBeep = True ' make sure subsequent E21 cell selection would not trigger any beep and action
Target.Offset(0, 1).Select
MsgBox "1.Error"
End If
ElseIf Target.Column = 5 Then
If Target.Row = 21 Then
If dontBeep Then
dontBeep = False ' restore default triggering conditions
Else
Beep
Target.Offset(0, 1).Select
MsgBox "2.Error"
End If
End If
End If
End If
End Sub
you could also take row index check at the beginning, since it's the same for both relevant columns:
Dim dontBeep As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If [B21] = "" Then
If Target.Row = 21 Then
If Target.Column = 4 Then
Beep
dontBeep = True ' make sure subsequent E21 cell selection would not trigger any beep and action
Target.Offset(0, 1).Select
MsgBox "1.Error"
ElseIf Target.Column = 5 Then
If dontBeep Then
dontBeep = False
Else
Beep' restore default triggering conditions
Target.Offset(0, 1).Select
MsgBox "2.Error"
End If
End If
End If
End If
End Sub
Related
I need help with Excel VBA code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Cells.Count = 1 Then
If LCase(Target.Value) = "-1" Then
With Target.EntireRow.ClearContents
End With
End If
End If
If Target.Column = 3 And Target.Cells.Count = 1 Then
If LCase(Target.Value) = "1000" Then
With Target.EntireRow
.Copy Sheets("Week Schedule").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
.Delete
End With
End If
End If
End Sub
If the third column we enter -1 it will clear the row. If we enter 1000 it will be copied to another sheet and deleted from the current sheet.
The above code is working fine. Instead of clearing row data, I want to delete that row.
So added
Line 4 With Target.EntireRow.ClearContents to With Target.EntireRow.Delete
But it shows an error.
It would help to know what error you get. Assuming the error is caused because the Week Schedule sheet does not exist, you can add a check for that. After that, your code works fine:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Cells.Count = 1 Then
If LCase(Target.Value) = "-1" Then
With Target.EntireRow.ClearContents
End With
End If
End If
If Target.Column = 3 And Target.Cells.Count = 1 Then
If LCase(Target.Value) = "1000" Then
With Target.EntireRow
SheetExistsOrCreate ("Week Schedule")
.Copy Sheets("Week Schedule").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
.Delete
End With
End If
End If
End Sub
Function SheetExistsOrCreate(name As Variant)
For i = 1 To Worksheets.Count
If Worksheets(i).name = "MySheet" Then
exists = True
End If
Next i
If Not exists Then
Worksheets.Add.name = name
End If
End Function
Please, try the next adapted code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 And Target.Cells.Count = 1 Then
Application.EnableEvents = False
If LCase(Target.Value) = -1 Then
Target.EntireRow.Delete
ElseIf Target.Value = 1000 Then
With Target.EntireRow
.Copy Sheets("Week Schedule").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
.Delete
End With
End If
Application.EnableEvents = True
End If
End Sub
The above code assumes that the Target value means a number, not a string looking as a number. If a string, you can place them between double quotes, as in your initial code.
Of course, a sheet named "Week Schedule" must exist in the active workbook and must not be protected.
In my code, I get runtime error 1004, "unable to set the Locked property of the Range class" every time if I change BX cell value from unlocked to any other. If I change any other value to unlocked code runs good. However, even if C column cells weren't previously merged the error occurs. Also, even if C cells where previously merged, they should be unmerged by Target.Offset(0, 1).Value = "0" this line, which calls second condition in my function. Why I'm getting this error?
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim pass As String
pass = "" 'set the password. Otherwise, protection/unprotection is done without a pass
If Not Intersect(Target, Range("B14:B50")) Is Nothing And Sh.Name <> "Dane" Then
If Target.Cells.Count > 1 Then Exit Sub
ActiveSheet.Unprotect pass
If Target.Value = "Unlocked" Then
Target.Offset(0, 1).Locked = False
Else
Target.Offset(0, 1).Value = "0"
Target.Offset(0, 1).Locked = True
End If
ActiveSheet.Protect pass
End If
If Not Intersect(Target, Range("C14:C50")) Is Nothing And Sh.Name <> "Dane" Then
Dim i As Long
Dim rng As Range
Application.DisplayAlerts = False
Application.EnableEvents = False
ActiveSheet.Unprotect pass
For i = 1 To 8 Step 1
If i <> 6 And i <> 7 And Cells(Target.Row, i).MergeCells Then
Cells(Target.Row, i).UnMerge
End If
Next i
If Target.Value <> 0 Then
Dim cf As Boolean
If Target.Value > 1 Then
For i = 1 To 8 Step 1
If i <> 6 And i <> 7 Then
Range(Cells(Target.Row, i), Cells(Target.Row + Target.Value - 1, i)).Merge
End If
Next i
End If
For i = 14 To 50 Step 1
If Not cf Then
Set rng = Range("A" & i).MergeArea.Resize(, 8)
With rng
.Borders.LineStyle = xlNone
.Interior.Color = RGB(217, 225, 242)
.BorderAround xlContinuous, xlThin, Color:=RGB(142, 169, 219)
End With
Else
Range("A" & i).MergeArea.Resize(, 8).Interior.Color = xlNone
End If
i = (i + Range("A" & i).MergeArea.Cells.CountLarge) - 1
cf = Not cf
Next i
End If
ActiveSheet.Protect pass
Application.EnableEvents = True
Application.DisplayAlerts = True
End If
End Sub
I think, your code problem is the following:
Any change in "C14:C50" range (even done by first event part, a change in range "B14:B50"), will indeed trigger the second event part, which will merge/unmerge ranges as you want. I did not spend to much time to understand if all logic is OK.
The problem is that this second triggered event ends with ActiveSheet.Protect pass.
The first interrupted event does not start from the beginning. It continues from the line where has been stopped. Meaning that the worksheet will not be unprotected in the moment you try locking a cell in C:C column.
In order to solve the problem, please insert the next line:
If ActiveSheet.ProtectContents Then ActiveSheet.Unprotect pass
just before:
Target.Offset(0, 1).Locked = True
The inserted line, will unprotect the sheet in the situation described above, too.
I have an excel worksheet that I want to assign to it more than one Worksheet Event.
To be more specific, I want whenever a cell in column B is changed then one cell to the left (column A) gets the row number.
Also I want whenever a cell in column J is changed then one cell to the right (column K) gets today's date.
It worked for me for both of them individually but I think I may be doing something wrong using them together.
Any help will be much appreciated!
Private Sub AG1(ByVal a_Target As Range)
If Not Intersect(a_Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(a_Target.Row, a_Target.Column - 1) = a_Target.Row
Application.EnableEvents = True
End If
End Sub
Private Sub AG2(ByVal b_Target As Range)
If Not Intersect(b_Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(b_Target.Row, b_Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
edit - works now (I also added that column can be referred as letter):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "B" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
ElseIf Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "J" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
Copy the code in the Worksheet_Change event and that should fix your issue. This will trigger every time you enter a value for any cell and will only meet the condition if they intersect the range in the if statement.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
End If
If Not Intersect(Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
I want to continuously scan barcodes into excel. Each scan will go into the same row separate cell until "$" is scanned and return to original column and next row.
I have tried this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Target.Column
Case 3 'column c
If Target.Value <> "" Then
Target.Offset(0, 1).Select 'move right
End If
Case 4 'column d
If Target.Value <> "" Then
Target.Offset(0, 1).Select 'move right
End If
Case 5 'column E
If Target.Value <> "" Then
Target.Offset(1, -2).Select 'move down and back to column C
End If
End Select
End Sub
This should work for you.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Scan As Variant
Scan = Trim(Target.Value)
If Len(Scan) And Target.Column > 2 Then
If Left(Scan, 1) = "$" Then
Scan = Mid(Scan, 2)
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
If Target.Column > 3 Then
Target.ClearContents
Set Target = Cells(Target.Row + 1, 3)
End If
Target.Value = Scan
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If
Target.Offset(0, Sgn(Val(Scan))).Select
End If
End Sub
The code was expanded to include the new requirements as per your comment.
I am using a simple code to enter date and time automatically in 2 separate cells in the excel sheet, however, they change automatically if I enter a new value in the cell or just press "Delete" Key. Below is the code I am using:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, -2).Value = Date
Application.EnableEvents = True
If Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
Target.Offset(0, -1).Value = Time
Application.EnableEvents = True
End Sub
I need the date and time to remain static until I delete them from their respective cells. How can I achieve this?
This will preserve the date/time once they have been entered:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 Then Exit Sub
Application.EnableEvents = False
If Target.Offset(0, -2).Value = "" And Target.Offset(0, -2).Value = "" Then
Target.Offset(0, -2).Value = Date
Target.Offset(0, -1).Value = Time
End If
Application.EnableEvents = True
End Sub
EDIT#1:
This version will allow you to both set and clear multiple cells in column E:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, i1 As Long, i2 As Long
If Target.Column <> 5 Then Exit Sub
With ActiveSheet.UsedRange
i2 = .Rows.Count + .Row - 1
i1 = .Row
End With
Application.EnableEvents = False
For Each r In Intersect(Target, Range("E" & i1 & ":E" & i2))
If r.Offset(0, -2).Value = "" And r.Offset(0, -1).Value = "" And r.Value <> "" Then
r.Offset(0, -2).Value = Date
r.Offset(0, -1).Value = Time
End If
Next r
Application.EnableEvents = True
End Sub
Clearing a cell that is already empty will not cause a time/date recording.
Stepping through your code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column <> 5 Then Exit Sub
"If the target's column is not 5 then exit the subroutine" This is cool.
Application.EnableEvents = False
Flipping this to false insures that this code won't run again until this value is set to true. Worksheet_Change needs enableevents to be on. So now if the cell that changed was in Column E then Worksheet_Change will be kept from executing again. This makes sense to keep infinite loops from happening as cells are changed via this code.
Target.Offset(0, -2).Value = Date
Set the cell that is two columns back from the target cell to the current date.
Application.EnableEvents = True
Set enableEvents back on. This is good since you probably don't want to leave this off.
If Target.Column <> 5 Then Exit Sub
Why are we checking this again? Target.Column hasn't changed since last time, and if it was already <>5 then we wouldn't be here to test it. This line is superfluous.
Application.EnableEvents = False
OK.. Well we just turned this on, but now we are turning this off again. Just leave it off.
Target.Offset(0, -1).Value = Time
Set the value 1 column to the left of the target cell to the current time. Coolios.
Application.EnableEvents = True
Turn enableEvents back on. This makes sense here.
End Sub
Rewriting this to remove the redundant toggles and superflous target.Column check:
Private Sub Worksheet_Change(ByVal Target As Range)
'make sure this is column 5 that was changed. Like if anything changed in
' column 5, then run the rest of this.
If Target.Column <> 5 Then Exit Sub
'Make sure we don't infinite loop if we accidently trigger a change to
' column 5 in this code.
Application.EnableEvents = False
' Set two cells to the left to the current date
' and one cell to the left to the current time
Target.Offset(0, -2).Value = Date
Target.Offset(0, -1).Value = Time
'turn events back on.
Application.EnableEvents = True
End Sub
So.. Everytime you make a change in Column 5, the date and time change. IF you want it so that it only changes a row's date and time once. Then check to see if date and time are already set for the row:
Private Sub Worksheet_Change(ByVal Target As Range)
'make sure this is column 5 that was changed. Like if anything changed in
' column 5, then run the rest of this.
If Target.Column <> 5 Then Exit Sub
'Check to see if the date and time are already set for this row:
' If they are, then exit subroutine.
If target.offset(0,-2).value <> "" OR target.offset(0,-1).value <> "" Then Exit Sub
'Make sure we don't infinite loop if we accidently trigger a change to
' column 5 in this code.
Application.EnableEvents = False
' Set two cells to the left to the current date
' and one cell to the left to the current time
Target.Offset(0, -2).Value = Date
Target.Offset(0, -1).Value = Time
'turn events back on.
Application.EnableEvents = True
End Sub