this code is not working as expected,it should compare like ( 1st row compared to 2nd , 1st to 3rd and so on if any duplicates value are there than it should restrict to move next line)
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Columns("A:F")) Is Nothing Then
If Target.Value <> "" Then
If Target.Value = Target.Offset(-1, 0).Value Or _
Target.Value = Target.Offset(1, 0).Value Then
MsgBox "Duplicate when introduced " & Target.Value & " in " & Target.Address
Debug.Print Target.Address
End If
End If
End If
End Sub
Related
The following does what I want it to by adding formulas when a value is entered into the Target cell, and then deletes said value when the cell is empty.
However, I keep running into a Debug Error if I were to right-click and delete that row within the Target Range, is there a way to prevent this from happening?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("C11:C1000")) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, -1).Formula = "=VLOOKUP(" & Target.Address & ",UIDs!$F$3:$H$750,3,FALSE)"
Else:
Target.Offset(0, -1).Value = ""
End If
End If
End Sub
Debug Error:
Then it takes me to If Target.Value <> "" Then if I click Debug.
You can confirm that Target is only 1 cell (as it will be a lot more than that when you delete a row):
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("C11:C1000")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target.Value <> "" Then
Target.Offset(0, -1).Formula = "=VLOOKUP(" & Target.Address & ",UIDs!$F$3:$H$750,3,FALSE)"
Else
Target.Offset(0, -1).Value = ""
End If
Application.EnableEvents = True
End If
End Sub
After a deep research on the internet I managed to find a VBA code that allows me to remember the previous result of a formula. I would like to modify this code to obtain the previous value of the formulas in one column in another column next to it.
For example: if '' B2: B80 "contains formulas, I would like" D2: D80 "to show the previous value of those formulas.
The code that I show does not keep the previous values in a single cell but continuously populates a column down and my goal is to obtain the previous value of each formula in a single cell, but of several cells of a column.
Dim xVal As String
Private Sub Worksheet_Change(ByVal Target As Range)
Static xCount As Integer
Application.EnableEvents = False
If Target.Address = Range("C2").Address Then
Range("D2").Offset(xCount, 0).Value = xVal
xCount = xCount + 1
Else
If xVal <> Range("C2").Value Then
Range("D2").Offset(xCount, 0).Value = xVal
xCount = xCount + 1
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xVal = Range("C2").Value
End Sub
Please try this simple code. I think it will do what you want.
Sub CopyValues()
With Worksheets("Sheet1") ' enter your tab's name here
.Range("B2:B80").Copy
.Cells(2, "D").PasteSpecial xlValues
End With
Application.CutCopyMode = False
End Sub
i use something similar to track changes on another sheet. Maybe this will help?
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sSheetName As String
sSheetName = "Data"
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
Sheets("LogDetails").Columns("A:E").AutoFit
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ErrHandler:
n = 1 / 0
Debug.Print n
oldValue = Target.Value
oldAddress = Target.Address
Exit Sub
ErrHandler:
n = 1
' go back to the line following the error
Resume Next
oldValue = Target.Value
oldAddress = Target.Address
End Sub
This tracks each change made in all sheets bar the LogDetails so would record all your changes.
I believe if you add the last sub into yours and change the reference it should work.
I am writing code which compares date entered in one column to date in another column. An error message is displayed if the entry violates data validation rules.
Also, I have disabled cut-paste operation and ctl+d.
Data Validation rules:
Enter valid date between 01/01/1900 and 12/31/9999
Date value in Column AP should be greater than Column AO.
But, when a user copies a cell, selects multiple cells in the target column and pastes, then data validation doesn't trigger at all. Below is the screenshot:
The below code handles single cell operations like copying a cell and paste in another cell but not able to handle when a user selects more than one cell and pastes.
Please help me understand as what is wrong with my code. Thank you!
Here is my code:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrorHandler
Dim lstrow As Long
lstrow = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub
If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The date you have entered is either not in correct format OR less than date in column AO")
Else: Target.NumberFormat = "dd-mmm-yyyy"
End If
ErrorExit:
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
End Sub
I tried the below code but it didn't work.
if Target.cells.count > 1 then
msgbox("Select a single cell to paste")
ActiveCell.Select
end if
'========================================================================
I have encountered another issue. Now, I want to evaluate one more column in the same worksheet under worksheet_change event. But, code for only one column is getting evaluated and not the other column.
Please advise.
Here is my updated code:
Private Sub Worksheet_Change(ByVal Target As Range)
'Added to define the last row by locating the text string (blank)
On Error GoTo ErrorHandler
Dim lstrow As Long
'ActiveRow = ActiveCell.Row
lstrow = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("AP5:AP" & lstrow)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "Select only single cell to paste"
ActiveCell.Select
Application.CutCopyMode = False
Application.EnableEvents = True
Exit Sub
End If
If Target.Value <> "" And Target.Value <= Range("AO" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The date you have entered is either not in correct format OR less than Column AO")
Else: Target.NumberFormat = "dd-mmm-yyyy"
Application.EnableEvents = True
Exit Sub
End If
'----------------------------------------------------------------------------------
If Intersect(Target, Range("AL5:AL" & lstrow)) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
MsgBox "Select only single cell to paste"
ActiveCell.Select
Application.CutCopyMode = False
Application.EnableEvents = True
Exit Sub
End If
If Target.Value <> "" And Target.Value <= Range("AK" & Target.Row) Then
Application.EnableEvents = False
Target.Value = ""
MsgBox ("The value you entered is less than the value in column AK")
Else: Target.NumberFormat = "0.00"
Application.EnableEvents = True
Exit Sub
End If
'----------------------------------------------------------------------------------
ErrorExit:
Application.EnableEvents = True
Exit Sub
ErrorHandler:
Debug.Print Err.Number & vbNewLine & Err.Description
Resume ErrorExit
End Sub
Can we evaluate two different ranges in the same worksheet_change event?
screenshot of the worksheet after the code is run:
After the line
If Intersect(Target, Range("AP5:AP" & lstrow - 1)) Is Nothing Then Exit Sub
Try inserting this additional checking:
If Target.Cells.Count > 1 Then
Application.EnableEvents = False
Application.Undo
msgBox "entering many cells simultaneously in column AP is not allowed"
Application.EnableEvents = True
Exit Sub
End If
I have been looking for days to solve this and have only come up with half the solution.
What I can do:
I would simply like to have one cell turn green inside with an x inserted when another cells data has the word "Complete" inside it.
What I cannot do:
I would like that same cell that turned green with an x inserted into it when the word "Complete" is changed to "Rework" to stay green with an x.
So Cell A1 is blank then in cell B1 the word "Complete" is added. Then cell A1 changes to green and has an x inside it. If later B1 changes to "Rework" I would like A1 to stay green with the x inside. So I can know that at one time the status of B1 was at one time "Complete"
I have been trying Conditional Formatting with rules but cannot get it to stay. I think the "Stop If True" check box within would be part of the solution but not sure what the code would be.
I already have a different macro running on this sheet so if the answer is a macro I will need it to be added to it. Below is the macro in the sheet already. Thank you.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count)) Is Nothing Then
If Target.Count < Columns.Count Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Dim r As Range
For Each r In Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
Ideally you'd split this up into separate subs to handle each of the change types, but this should give you an idea:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, r as Range
'skip full-row changes (row insert/delete?)
If Target.Columns.Count = Columns.Count Then Exit Sub
Set rng = Intersect(Target, Range("N:N,Y:Y"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
With r.Offset(0, 1)
.Value = Now 'use Now to retain the time as well as the date
.NumberFormat = "mm/dd/yy" 'change to what you prefer
End With
Next r
End If
Set rng = Intersect(Target, Range("B:B"), Range("10:" & Rows.Count))
If Not rng Is Nothing Then
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
For Each r In rng.Cells
If r.Value = "Complete" Then
With r.Offset(0, -1)
.Value = "x"
.Interior.Color = vbGreen
End With '<<EDIT thanks #BruceWayne
End If
Next r
End If
bm_Safe_Exit:
Application.EnableEvents = True
End Sub
You'll need two worksheet events, and some If statements. The following should help you get started, unless I'm overlooking something.
Dim oldVal as String ' Public variable
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Debug.Print Target.Address
If Target.Cells.Count <> 1 Then Exit Sub
oldVal = Target.Value
End Sub
The above will make note of the oldValue.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim newVal As String
newVal = Target.Value
If newVal = oldVal Then
Debug.Print "Same Values"
ElseIf oldVal = "Complete" And newVal = "Rework" Then
Debug.Print "Stay green with X"
ElseIf oldVal = "" And (newVal = "Complete" Or newVal = "complete") Then
Debug.Print "Change cell to Green, add an 'X'"
Target.Interior.ColorIndex = 10
Target.Value = Target.Value & " x"
End If
End Sub
Then, add/tweak those If statements as necessary, and add the color changing/reverting code to the appropriate block.
(There may of course be a better mousetrap, but I think this should get you going).
I have two macros altogether, one macro assigned to my Private Worksheet_Change event and the other assigned to my Private Worksheet_SelectionChange event like so:
Macro 1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If Hours Column Selected
If Not Intersect(Target, Range("Z" & ActiveCell.Row)) Is Nothing And Range("Z" & ActiveCell.Row).Value <> "" Then
NewValue = Application.InputBox("Please Enter Your Delegated Reference:")
If NewValue <> vbNullString Then
Dim rw2 As Long, cell2 As Range
rw2 = ActiveCell.Row
With Worksheets("Data").Columns("I:I")
Set cell2 = .find(What:=NewValue, LookIn:=xlFormulas, _
LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
If Not cell2 Is Nothing Then
Application.DisplayAlerts = False
cell2.Offset(0, 4).Value = Sheet1.Range("Y" & ActiveCell.Row).Value
cell2.Offset(0, 5).Value = Sheet1.Range("H" & ActiveCell.Row).Value
cell2.Offset(0, 6).Value = Sheet1.Range("I" & ActiveCell.Row).Value
MsgBox "Found"
Sheet1.Range("Y" & ActiveCell.Row).Value = cell2.Offset(0, 1).Value
Sheet1.Range("H" & ActiveCell.Row).Value = cell2.Offset(0, 2).Value
Sheet1.Range("I" & ActiveCell.Row).Value = cell2.Offset(0, 3).Value
Application.DisplayAlerts = True
Else
MsgBox "Not Found"
Sheet1.Range("A5").Select
End If
End With
Else
If NewValue = vbNullString Then
MsgBox "Not Found"
Sheet1.Range("A5").Select
End If
End If
End If
End Sub
Macro 2
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("Y" & ActiveCell.Row)) Is Nothing Then
myValue3 = MsgBox("This is a message")
End If
End Sub
The problem I have is when I click on my active cell row in column Z I am running macro 1 and asking it to update the value of my active cell row in column Y. However when the information in column Y is updated, it is causing macro 2 to run where I get a msgbox displaying and I don't want this to happen.
Whilst I still require macro 2 and do want the msgbox to display, I only want it to display when I click on the cell in column Y. So in other words, I want to be able to cancel out macro 2 if macro 1 is running.
I have tried using application.displayevents = false in macro 1 but this doesn't work.
Please can someone show me the best way to do this?
you can use
Application.EnableEvents = False
.. at the start of your macro1 to disable events and
Application.EnableEvents = True
To turn it back on again at the end of macro1.
Please try the following:
[1] Add a new Module to your VBA Project, with the following:
Public EventRunning as Boolean
[2] Modify your Worksheet_SelectionChange macro as follows:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
EventRunning=True
...
EventRunning=False
End Sub
[3] Modify your Worksheet_Change as follows:
Private Sub Worksheet_Change(ByVal Target As Range)
If EventRunning Then Exit Sub
...
Best wishes Ben