My problem is that my code doesn't work how I think it should work. I have Loop in my worksheet_change macro, and in that loop I want that if statement is correct (MsgBox button pressed Yes), what is written in that cell would have appended value at the end of that text.
But if I run this macro and I press Yes - cell value has the value at the end, but MsgBox comes right again, and I'm stuck in that loop... I'm new to VBA programming and syntax.
Can someone help me and explain my mistake?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rLockable As Range
Dim cl As Range
Set rLockable = Range("C13:J1000")
Set cl = Range("C13:J1000")
Set cele = Range("K13:K1000")
vardas = ActiveWorkbook.Sheets("Login").Range("O8").Value
Select Case True
Case Not Intersect(rLockable, Target) Is Nothing
'If target is within the range then do nothing
If Intersect(rLockable, Target) Is Nothing Then Exit Sub
ActiveSheet.Unprotect Password:="1234"
For Each cl In Target
If cl.Value <> "" Then
check = MsgBox("Ar áraðyti áraðà? Koreguoti áraðo nebegalësite.", vbYesNo, "Áraðo iðsaugojimas")
If check = vbYes Then
Target.Worksheet.Unprotect Password:="1234"
cl.MergeArea.Locked = True
cl.Value = cl.Value & " " + vardas
Else
cl.Value = ""
ActiveSheet.Protect Password:="1234"
End If
End If
Exit For
Next cl
Case Not Intersect(Range("K13:K1000"), Target) Is Nothing
ActiveSheet.Unprotect Password:="1234"
For Each cele In Target
If cele.Value <> "" Then
cele.Offset(0, 2).MergeArea.Value = vardas
End If
Exit For
Next cele
End Select
ActiveSheet.Protect Password:="1234"
End Sub
Before making a change to the worksheet you need to set enableEvent to false or the worksheet_change event will kick in again.
application.enableEvents=false
'change the worksheet
application.enableEvents=true
'resets the worksheet_change event
Related
I want to check if specific range (L32,M32;N32;O32;P32;Q32,R32;S32;T32).
If one of the cells is not empty a message should be displayed "FSFV check".
For Each cell In Range("L32:T32")
If cell.Value <> "" Then
MsgBox "Check with CRA if FSFV was performed and notify RA"
Else
End If
Next
End Sub
It displays the message eight times but I only want it once.
How about :
Sub Test()
Dim AnyData As Integer
AnyData = WorksheetFunction.CountA(Range("L32:T32"))
If AnyData = 0 Then
Exit Sub
Else
MsgBox "Check with CRA if FSFV was performed and notify RA"
End If
End Sub
If a Cell in a Range Is Blank...
If you're practicing loops, you could do the following.
Sub Test1()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim cell As Range
For Each cell In ws.Range("L32:T32").Cells
If Len(CStr(cell.Value)) = 0 Then ' cell is blank
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
Exit For ' blank cell found, stop looping
' Or:
'Exit Sub ' blank cell found, stop looping
End If
Next cell
' With 'Exit For' you'll end up here
' and you could continue with the sub.
End Sub
If not, rather use the following.
Sub Test2()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
If Application.CountBlank(ws.Range("L32:T32")) > 0 Then
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
End If
End Sub
Hardly Related But Interesting
If you were wondering what happens to an object-type Control variable (in this case cell) in a For Each...Next loop when the loop has finished uninterrupted, the following example proves that it is set to Nothing.
Sub Test3()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim cell As Range
For Each cell In ws.Range("L32:T32").Cells
If Len(CStr(cell.Value)) = 0 Then Exit For
Next cell
If Not cell Is Nothing Then
MsgBox "Check with CRA if FSFV was performed and notify RA", _
vbExclamation
Exit Sub
End If
MsgBox "Continuing...", vbInformation
End Sub
Let me give you the simplest approach:
Dim Found As Boolean
Found = False
For Each cell In Range("L32:T32")
If cell.Value <> "" Then
Found = True
End If
Next
If Found Then
MsgBox "Check with CRA if FSFV was performed and notify RA"
End If
As you see, the fact that you have found an empty cell is kept in a Boolean variable, and afterwards you just use that information for showing your messagebox.
I want the user's name and the date to be entered into a specified column when any change is made.
I also have a snippet of code that forces any data that is pasted into the sheet to be pasted as values so the sheet's formatting is maintained.
I was able to write code that functioned properly, but the event was also being triggered even when the user double clicked in a cell and clicked out of the cell (i.e., no change was made). A user could accidentally click into a cell and leave it without making changes, but their name would be left behind as having made an edit.
I tried to incorporate this solution. Here is a simplified version of my code:
Private Sub Worksheet_Change(ByVal Target as Range)
Dim DesiredRange as Range
Dim TOld, TNew as String
Set DesiredRange as 'Whatever range I'm using
If Not Intersect(Target, DesiredRange) is Nothing Then
TNew = Target.Value
With Application
.EnableEvents = False
.Undo
End With
TOld = Target.Value
Target.Value = TNew
If Application.CutCopyMode = xlCopy Then
Application.EnableEvents = False
Application.Undo
Target.PasteSpecial Paste:=xlPasteValues
Application.EnableEvents = True
End if
If TOld <> TNew Then
Target.Offset(0, 23 - Target.Column) = Application.Username & vbNewLine & Date
End If
Application.EnableEvents = True
End if
End Sub
I am encountering the following issue:
When a user double clicks into a cell and clicks into another cell, the event is not triggered (i.e., the user's name and date is not left in the cell) but the active cell is reverted into the original cell, rather than the one they clicked into after double-clicking.
So a user would double click into a cell, do nothing, then click into another cell, and the active cell would revert to the first cell they were in.
This is also happening after the user inputs their change into the cell and presses enter.
I also encounter an error when something is pasted into the sheet, causing the code to not execute properly.
Prevent Worksheet Change When No Change
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
Dim srg As Range: Set srg = Range("B5:E10")
Dim irg As Range: Set irg = Intersect(srg, Target)
If irg Is Nothing Then Exit Sub
Dim coll As Collection: Set coll = New Collection
Dim iCell As Range
For Each iCell In irg.Cells
coll.Add iCell.Value
Next iCell
With Application
.EnableEvents = False
.Undo
End With
Dim drg As Range
Dim n As Long
For Each iCell In irg.Cells
n = n + 1
If iCell.Value <> coll(n) Then
iCell.Value = coll(n) ' write different value
If drg Is Nothing Then ' combine the cells for user and date
Set drg = iCell
Else
Set drg = Union(drg, iCell)
End If
End If
Next iCell
If Not drg Is Nothing Then
' Use 'Now' while testing or you will see no difference.
' Later switch to 'Date'.
Intersect(drg.EntireRow, Columns("W")).Value = Application.UserName _
& vbNewLine & Format(Now, "mm/dd/yyyy hh:mm:ss") ' Date
End If
SafeExit:
If Not Application.EnableEvents Then Application.EnableEvents = True
Exit Sub
ClearError:
Debug.Print "Run-time error '" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
I have a problem with VBA, I need to use the worksheet change event to pickup cell values from AI28 to AI30 and move them over to V28 to V30. This is what I have do so far
Private Sub Worksheet_Change(ByVal Target As Range)
If IsNumeric(Target) And Not (Target = "") Then
If Target.Address = Range("AI28:AI30").Address Then
Range("V28:V30").Value = Range("AH28:AH30").Value
Else
If Target.Cells.Value <> Empty Then Exit Sub
Exit Sub
End If
End If
End Sub
It works fine for just one range eg AI28 and V28 so what am I missing? A loop or something?
Use a loop and Intersect:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Intersect(Target, Me.Range("AI28:AI30"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell As Range
For Each cell In rng
If IsNumeric(cell.Value) And Not IsEmpty(cell.Value) Then
Me.Range("V" & cell.Row).Value = cell.Value
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
I have a macro where i import a text file and update some elements of this file using the macro and then re-create the text file with the updated elements. I am validating some of the cells in a particular worksheet (USERSHEET)to make sure the user entries are correct and using the below Sub:
Option Explicit
Public Rec_Cnt As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
Rec_Cnt = Sheets("MD").Cells(3, 7)
Dim Rng1 As Range
Dim Rng2 As Range
Dim Rng3 As Range
Set Rng1 = Range("E2:E" & Rec_Cnt)
Set Rng2 = Range("K2:K" & Rec_Cnt)
Set Rng3 = Range("Q2:Q" & Rec_Cnt)
If Not Application.Intersect(Target, Rng1) Is Nothing Then
If Len(Target) > 10 Then
Call Original_Ticket_Error
Exit Sub
End If
ElseIf Not Application.Intersect(Target, Rng2) Is Nothing Then
If Len(Target) > 10 Then
Call Original_Cnj_Ticket_Error
Exit Sub
End If
ElseIf Not Application.Intersect(Target, Rng3) Is Nothing Then
If Len(Target) > 10 Then
Call Original_Ticket_Error
Exit Sub
End If
End If
End Sub
Sub Original_Ticket_Error()
MsgBox "Original Ticket Number is more 10 characters"
End Sub
Sub Original_Cnj_Ticket_Error()
MsgBox "Original Conj. Ticket Number is more 10 characters"
End Sub
===============================================================================
Once the text file is created with the updated columns I am clearing all the cells in the USERSHEET.
However, I get a run-time error '13' for type mismatch
I wanted to check how can I avoid calling the Private Sub Worksheet_Change(ByVal Target As Range) after the worksheet(USERSHEET) is cleared
Any help is much appreciated.
Thanks,
sachin
Edit:
Code used to clear usersheet:
Sub Clear_User_Sheet()
Sheets("UserSheet").Select
Range("A2:R100002").Select
Application.Wait (Now + TimeValue("0:00:01"))
Selection.Delete
Application.EnableEvents = False
Application.Wait (Now + TimeValue("0:00:01"))
Selection.Delete
Selection.Delete
Sheets("Control Panel").Select
End Sub
Try this version of Clear_User_Sheet instead:
Sub Clear_User_Sheet()
Application.EnableEvents = False
Sheets("UserSheet").Range("A2:R100002").Delete
Application.EnableEvents = True
End Sub
PS. If you've used the code that you suggested in your edited answer, you may well find that EnableEvents is currently set to False - you'll want to correct that before running anything else.
I made a VB makro in Excel to execute something if the cell is in a given range but when I execute it it gives me an error and I don't see why.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim isect As Boolean
isect = Application.Intersect(Selection, Range("D11:D35"))
If isect Then
If ActiveCell.Offset(-1, 0) - ActiveCell.Offset(-1, 1) > 2.5 Then
Range("A1:A1").Value = "ok"
End If
End If
End Sub
The error is:
Object variable or With block variable not set.
Change the first 3 lines into:
Dim isect As Range
Set isect = Application.Intersect(Selection, Range("D11:D35"))
If Not isect Is Nothing Then
but check also comment from #Siddharth about looping which is very important here.
Another way without using a Boolean Variable / Selection (Also Incorporating Tim's suggestion as well)...
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Target.Cells.CountLarge > 1 Then
MsgBox "More than 1 cell ws changed"
Else
If Not Intersect(Target, Range("D11:D35")) Is Nothing Then
If Target.Offset(-1, 0).Value - Target.Offset(-1, 1).Value > 2.5 Then
Range("A1").Value = "ok"
End If
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Note: Why .CountLarge? See this