Excel VBA Target.address worksheet.onchange infinite loop - excel

I have cell A1, cell B1 and cell C1, I need check if value changed in A1 by user or by VBA. Whith out If statment on Target.Address A1 makes infinite loop
Private Sub Worksheet_Change(ByVal Target As range)
If Target.Address = B1 or Target.Address = C1 Then
If IsEmpty(Cell("B1")) then
Cell("A1").value = "Enter value"
If IsEmpty(Cell("C1")) then
Cell("A1").value = ""
Else
Cell("A1").value = "=C1/B1"
End IF
End IF
End IF
If Target.Address = A1
IF "changed by user typing" Then
Cell("B1").value = ""
Cell("C1").value = ""
Else
End IF
End IF
End Sub
How to determine what Target was changed by user not from VBA?

I suspect you want something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
Range("B1:C1").Value = ""
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("B1:C1")) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(Range("B1")) Then
Range("A1").Value = "Enter value"
ElseIf IsEmpty(Range("C1")) Then
Range("A1").Value = ""
Else
Range("A1").Value = "=C1/B1"
End If
Application.EnableEvents = True
End If
End Sub

Related

Excel VBA hide columns based on dropdown selection and checkbox selection

Is there a possibility that the two codes below can be combined to so that if the checkbox is selected and the D11 cell has a specific selection then it would hide columns based on the two selections?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$11" Then
If Target.Value = "A" Or Target.Value = "C" Then
Sheets("Worksheet").Columns("BL:CH").Hidden = True
ElseIf Target.Value = "C" Then
Sheets("Worksheet").Columns("BL:BY").Hidden = False
End If
End If
End Sub
Private Sub CheckBox1_Click()
Sheets("Worksheet").Columns("BZ:CH").Hidden = Not Me.CheckBox1.Value (TO UNHIDE SPECIFIC COLUMS ONLY WHEN CHECKED)
End Sub
This is what I got to work. Thank you
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$11" Then
If Target.Value = "A" Or Target.Value = "B" Then
Sheets("Worksheet").Columns("BL:CH").Hidden = True
ElseIf Target.Value = "C" And Not Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = False
ElseIf Target.Value = "C" And Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = True
Sheets("Worksheet").Columns("BZ:CH").Hidden = False
End If
End If
End Sub

VBA Deleting Rows for Changed Cells Debug Error

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

Combining 3 Private Sub Worksheet_Change

I am a first time poster and a newby to VBA. So i am hoping i make sense :)
I am trying to combine 3 private subs, but not sure how to code it together.
I have a spreadsheet that has data validation and i want a input box to appear depending on what is selected.
In column "I" is the first set of data validation, with the options of Accepted, Declined and Null invoid, if "Accepted" then nothing, but if either Declined or Null in Void, I would like a pop up box to appear for the user to input $0, and past that to Column "D"
In Column "M" is the next one for data validation, with the only options is blank and Complete. if blank then nothing, but if Complete, i would like a pop up for the user to input the Quotation value, and past that to Column "D".
Thank you in advance.
This is my code
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Declined" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to 0", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Null in Void" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to 0", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M")) Is Nothing Then
If Target = "Complete" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to the Quotation Value", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M")) Is Nothing Then
If Target = "Complete" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To the Quotation Value", Type:=2)
Application.EnableEvents = TRUE
End If
ElseIf Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Declined" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To 0", Type:=2)
Application.EnableEvents = TRUE
ElseIf Target = "Null in Void" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To 0", Type:=2)
Application.EnableEvents = TRUE
End If
End If
End Sub
see this official docs.

Execute code if the value entered in the cell is not the same as the previous value

I have data validation as list for some cells (possible values are "Enrolled", "Waitlisted", "Cancelled"). I need to execute some code if the value of these cells changes, only if the new value is not the same as the existing one. Question is, how can I get Excel to compare the previous value of the cell with the current one.
I tried this solution (How do I get the old value of a changed cell in Excel VBA?) but it didn't work. What am I missing? Here is some sample code. Currently, it changes the cell colors even if I enter the same value.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim previous_value As String
previous_value = oval
Select Case Target.Value
Case Is = "enrolled"
If previous_value = Target.Value Then
MsgBox "you entered the same value"
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
Else
Target.Interior.Color = vbBlue
End If
Case Is = "waitlisted"
' (....etc.)
End Select
End Sub
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim oval As String
If Selection.Cells.Count = 1 Then
oval = Target.Value
End If
End Sub
If you use something like this below code, you can save the most recent clicked instance in a named range and then check it against whatever the user entered. Obviously, this goes in the respective sheet code.
Private anOldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
If Target.Value = anOldValue Then
MsgBox "Same value!"
End If
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
anOldValue = Target.Value
End If
End Sub
Here is the final code. Thanks #PGCodeRider for the help!
Private anOldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count = 1 Then
Select Case Target.Value
Case Is = "enrolled"
If Target.Value = anOldValue Then
MsgBox "Student already enrolled!"
Else 'code that needs to happen when "enrolled" is selected
Target.Interior.ColorIndex = 10
End If
Case Is = "waitlisted"
If Target.Value = anOldValue Then
MsgBox "Student already waitlisted!"
Else 'code that needs to happen when "waitlisted" is selected
Target.Interior.ColorIndex = 20
End If
Case Is = "cancelled"
If Target.Value = anOldValue Then
MsgBox "Student already cancelled!"
Else 'code that needs to happen when "cancelled" is selected
Target.Interior.ColorIndex = 30
End If
End Select
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then
anOldValue = Target.Value
End If
End Sub

Ambiguous name detected: Worksheet_change

I'm attempting to add a second code to a single worksheet and keep getting the "Ambiguous name detected" error. Realise that I need to combine the two codes but having trouble doing so. here are the two codes, one below the other:
Private Sub Worksheet_Change(ByVal Target As Range)
'are changes made within answer range?
Set isect = Application.Intersect(Target, Range("Answers"))
If Not (isect Is Nothing) Then
For Each chng In Target.Cells
'Get row number
startY = Impact.Range("Answers").Row
targetY = chng.Row
row_offset = (targetY - startY) + 1
rating_type = Impact.Range("Impacts").Cells(row_offset, 1)
If rating_type = "Major / V.High" Then cols = 16711884
If rating_type = "Significant / High" Then cols = 255
If rating_type = "Important / Moderate" Then cols = 49407
If rating_type = "Minor / Low" Then cols = 5287936
If rating_type = "" Then cols = 16777215
Impact.Range("Ratings").Cells(row_offset, 1).Interior.Color = cols
Impact.Range("Impacts").Cells(row_offset, 1).Interior.Color = cols
Next chng
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
' To Select Multiple Items from a Drop Down List in Excel
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Address = "$C$2" Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else: If Target.Value = "" Then GoTo Exitsub Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & ", " & Newvalue
Else:
Target.Value = Oldvalue
End If
End If
End If
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Was hoping someone knows how to combine the two in order to circumvent this error.
Thanks in advance!
Based on my comment, you can track changes in more than one range as shown in the below sample code.
Private Sub Worksheet_Change(ByVal Target As Range)
'Exit the sub if more than one cells are changed at the same time
If Target.CountLarge > 1 Then Exit Sub
'Disable the event so that if the code changes the cell content of any cell, the code is not triggered again
Application.EnableEvents = False
'Error handling to skip the code if an error occurs during the code execution and enable the events again
On Error GoTo ErrorHandling
'Change event code will be triggered if any cell in column A is changed
If Not Intersect(Target, Range("A:A")) Is Nothing Then
MsgBox "The content of a cell in colunm A has been changed."
'Change event code will be triggered if any cell in column C is changed
ElseIf Not Intersect(Target, Range("C:C")) Is Nothing Then
MsgBox "The content of a cell in colunm C has been changed."
'Change event code will be triggered if any cell in column E is changed
ElseIf Not Intersect(Target, Range("E:E")) Is Nothing Then
MsgBox "The content of a cell in colunm E has been changed."
End If
ErrorHandling:
Application.EnableEvents = True
End Sub

Resources