I have a file where I want to check if cell "$A$2" is empty and if that's true I want to add the formula (=VLOOKUP($I$2;'Raw Data'!$A$1:$AH$5000;4;FALSE) in this cell. Went I run the code below it generates a
Run-tim error '1004' (Application-defined or object defined error).
I already played with the target formula and if I take simple formulas like =B1+B2 it works and I don^t get an error message. So it seems to be something about the Vlookup formula that causes the error.
Private Sub Worksheet_Change(ByVal Target As Range)
If (Target.Cells.Address = "$A$2" And Target = vbNullString) Then
Target.Formula = "=VLOOKUP($I$2;'Raw Data'!$A$1:$AH$5000;4;FALSE)"
End If
End Sub
I expect the cell "$A$2" to show the result of the formula =VLOOKUP($I$2;'Raw Data'!$A$1:$AH$5000;4;FALSE) unless the cell is overwritten manually.
Thanks for your help #Pᴇʜ #eirikduade #Gareth!
Now I am trying to do the same for all cells in Column A where there is a value in column I of the same row and I struggle with the .Range function. Could you please give me any suggestions how to fix the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRowF As Integer
lastRowF = Sheet3.Cells(Sheet3.Rows.Count, "I").End(xlUp).Row
For j = 1 To lastRowF
If Intersect(Target, Me.Range(Cells(j, 2))) Is Nothing Then Exit Sub
If Me.Range(.Cells(j, 2)) = vbNullString Then
Me.Range(.Cells(j, 2)).Formula = "=VLOOKUP(""" & cells.(y, 1) & """,'Raw Data'!$A$1:$AH$5000,4,FALSE)"
Exit For
End If
Next j
End Sub
The main issue
You need to switch the ; to , because the .Formula needs to be the original english version of the formula which uses ,.
Your code will fail if Target is a range of multiple cells
Note that your code will fail if you eg. copy paste a range (not a single cell).
Change it to the following:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A2")) Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS
If Me.Range("A2").Value = vbNullString Then
Me.Range("A2").Formula = "=VLOOKUP($I$2,'Raw Data'!$A$1:$AH$5000,4,FALSE)"
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number <> 0 Then Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
If you need to do it for multiple cells in column A it would look like this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim AffectedRange As Range
Set AffectedRange = Intersect(Target, Me.Range("A2:A" & Me.Rows.Count))
Application.EnableEvents = False
On Error Goto ENABLE_EVENTS
If Not AffectedRange Is Nothing Then
Dim iCell As Range
For Each iCell In AffectedRange.Cells
If iCell.Value = vbNullString Then
iCell.Formula = "=VLOOKUP($I" & iCell.Row & ",'Raw Data'!$A$1:$AH$5000,4,FALSE)"
End If
Next iCell
End If
ENABLE_EVENTS:
Application.EnableEvents = True
If Err.Number <> 0 Then Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
End Sub
Note that you probably mean to use
"=VLOOKUP($I" & iCell.Row & ", 'Raw Data'!$A$1:$AH$5000,4,FALSE)"
instead of
"=VLOOKUP($I$2, 'Raw Data'!$A$1:$AH$5000,4,FALSE)"
In VBA code, you must use commas to separate arguments in functions, even if your local delimiter is semi-colons.
I.e. change the line
Target.Formula = "=VLOOKUP($I$2;'Raw Data'!$A$1:$AH$5000;4;FALSE)"
to
Target.Formula = "=VLOOKUP($I$2,'Raw Data'!$A$1:$AH$5000,4,FALSE)"
and see if that works
Related
I need to combine the following 3 subroutines into a single worksheet change event but I am unsure how.
I have tried writing one sub in the worksheet editor and another in the workbook editor. However given that I have 3 subroutines all referring to the same worksheet, I am unsure how to combine them. Any help is greatly appreciated!
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D3:D100")) Is Nothing Then
Exit Sub
Else
Dim i As Integer
For i = 3 To 100
If Range("D" & i).Value = "Remote" Then
Range("O" & i).Value = "N/A"
Range("P" & i).Value = "N/A"
Range("Q" & i).Value = "N/A"
End If
Next i
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target,Range("H3:H100")) Is Nothing Then
Exit Sub
Else
Dim e As Integer
For e = 3 To 100
If Range("H" & e).Value = 1 Then
Range("I" & e).Value = "N/A"
End If
Next e
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target,Range("I3:I100")) Is Nothing Then
Exit Sub
Else
Dim e As Integer
For e = 3 To 100
If Range("I" & e).Value = 1 Then
Range("H" & e).Value = "N/A"
End If
Next e
End If
End Sub
Flip the logic.
If Intersect(Target, Range("D3:D100")) Is Nothing Then
Exit Sub
Else
...
End If
Change this to
If Not Intersect(Target, Range("D3:D100")) Is Nothing Then
' Remove Exit Sub
' Remove Else
...
End If
Do the same for the two other Intersect calls and then combine everything into one Worksheet_Change handler.
Most likely you want to disable events as well, to avoid re-triggering the event when writing to the sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SafeExit
Application.EnableEvents = False
' Your three Intersect checks
SafeExit:
Application.EnableEvents = True
End Sub
try this. put this in the worksheet, not the workbook
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Not Intersect(Target, Range("D3:D100")) Is Nothing Then
c = 1
Else
If Not Intersect(Target, Range("H3:H100")) Is Nothing Then
c = 2
Else
If Not Intersect(Target, Range("I3:I100")) Is Nothing Then
c = 3
End If
End If
End If
Select Case c
Case 1
' your stuff
Case 2
'your stuff
Case 3
'your stuff
Case Else
End Select
End Sub
Can someone please help me with this code. It will insert the current date in H if I do any changes to I.
My problem is that this will not work if for example I fill in I1 with something, and then I drag down for copying in many cells at once. If for example I copy value from I1 once at a time in each cell( I2,I3 ETC) it will work.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'Updated by Extendoffice 2017/10/12
Dim xRg As Range, xCell As Range
On Error Resume Next
If (Target.Count = 1) Then
If (Not Application.Intersect(Target, Me.Range("I:I")) Is Nothing) Then _
Target.Offset(0, -1) = Date
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("I:I10"))
If (Not xRg Is Nothing) Then
For Each xCell In xRg
xCell.Offset(0, -1) = Date
Next
End If
Application.EnableEvents = True
End If
End Sub
Thank you !
Avoid the unnecessary use of On Error Resume Next. Handle the Error gracefully. I recommend reading THIS once when using Worksheet_Change
Also you have If (Target.Count = 1) Then because of which your code doesn't execute. When you drag, the count increases.
Is this what you are trying?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Dim aCell As Range
Application.EnableEvents = False
If Not Intersect(Target, Range("I:I")) Is Nothing Then
For Each aCell In Target
'~~> Additional blank check for I. So that the date
'~~> is not inserted if the value is deleted. Remove this
'~~> if you want the date to be inserted even when the value is deleted
If Len(Trim(aCell.Value)) <> 0 Then
Range("H" & aCell.Row).Value = Date
Else
'Remove Date?
End If
Next aCell
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
In action:
I have a trigger that I want to use in certain worksheet - just inside 2 specific columns. But whan I enter a value inside another range it triggers the Private Sub of that worksheet.
I want it would start to work just whan I cange value within columns E or H.
Is someone knows how to do it right?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LR As Long
Dim rng1 As Range
Dim rng2 As Range
'WE WANT TO KEEP THE TARGET COLUMNS BETWEEN 0% TO 100%
LR = Cells(Rows.Count, "A").End(xlUp).Row
Set rng1 = Intersect(Target, Range(Cells(2, "E"), Cells(LR, "E")))
On Error GoTo 1
If Target.Value < 0 Or Target.Value > 1 Then
MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
Target.Value = 0
Exit Sub
End If
On Error GoTo 1
Set rng2 = Intersect(Target, Range(Cells(2, "H"), Cells(LR, "H")))
If Target.Value < 0 Or Target.Value > 1 Then
MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
Target.Value = 0
Exit Sub
End If
1
End Sub
You just need to check if Target intersects with your desired range. I would Union the two columns together in this check.
As cryptically stated by DisplayName, since Target can contain more than one cell, you should check each cell in target individually. Alternatively, if your intention for Target was to always have one cell, then you can avoid the For...Each statement altogether and use this check: If Target.Cells.Count > 1 Then Exit Sub to not run the procedure when more than 1 cell is changed.
I also added another intersect target, Me.Rows("2:" & rows.count) to avoid updating any headers you may have. If your data does not contain headers, then you can remove this range from Intersect().
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo safeExit
Dim rngIntersect As Range
Set rngIntersect = Intersect(Target, Union(Me.Columns("E"), Me.Columns("H")), _
Me.Rows("2:" & Rows.Count))
If Not rngIntersect Is Nothing Then
Application.EnableEvents = False
Dim cel As Range
For Each cel In rngIntersect
If cel.Value < 0 Or cel.Value > 1 Then
MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, _
"error"
cel.Value = 0
End If
Next cel
End If
safeExit:
Application.EnableEvents = True
End Sub
As a side note, when you are using the same exact range more than once, it's not a bad idea to go ahead and set that range to a variable. So, we use rngIntersect twice in this code, so this prevents us from having to issue multiple calls to the Intersect() and Union() functions. On top of that, you run into less debugging headaches when you only have to update the range in one place rather than multiple times in your code.
The intersect can check if any of the cells in Target (yes, Target can be more than a single cell) intersect with the Union of columns E and H.
Private Sub Worksheet_Change(ByVal Target As Range)
' this next line could also be,
'If Not Intersect(Target, Range("E:E, H:H")) Is Nothing Then
If Not Intersect(Target, Union(Range("E:E"), Range("H:H"))) Is Nothing Then
On Error GoTo bye_bye
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Union(Range("E:E"), Range("H:H")))
If (t.Value2 < 0 Or t.Value2 > 1) And t.Row > 1 Then
MsgBox "bla bla bla", vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "error"
t = 0
End If
Next t
End If
bye_bye:
Application.EnableEvents = True
End Sub
I have code that retrieves information from SQL and VFP and populates a dropdown list in every cell in column "A" except A1 - this is a header.
I need to populate the "G" column on the row where the user selects the value from a dropdown in the "A" column.
I believe I need to be in Private Sub Worksheet_SelectionChange(ByVal Target As Range) which is in the sheet object.
Below is something similar to what I want to do.
If cell "a2".valuechanged then
Set "g2" = "8000"
End if
If cell "a3".valueChanged then
Set "g3" = "8000"
End if
The code above doesn't work, but I think it is easy to understand. I want to make this dynamic, so I don't have too many lines of code.
I have already explained about events and other things that you need to take care when working with Worksheet_Change HERE
You need to use Intersect with Worksheet_Change to check which cell the user made changes to.
Is this what you are trying?
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
'~~> Check if the user made any changes in Col A
If Not Intersect(Target, Columns(1)) Is Nothing Then
'~~> Ensure it is not in row 1
If Target.Row > 1 Then
'~~> Write to relevant cell in Col G
Range("G" & Target.Row).Value = 8000
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column <> 7 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
If you only need it to fire on column A then
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1 And Target.Column = 1 Then
Cells(Target.Row, "G").Value = 8000
End If
End Sub
can you not put an if statement in column G , as in
If (A1<>"", 8000,0)
Other wise something like this will get you going:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Column = 1 Then
If Target.Value2 <> "" Then
Target.Offset(0, 6) = "8000"
Else
Target.Offset(0, 6) = ""
End If
End If
On Error GoTo 0
End Sub
Thanks
Ross
I had a similar problem. I used Siddharth Rout's code. My modifications allow a user to paste a range of cells in column a (ex. A3:A6) and have multiple cells modified (ex. H3:H6).
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
'~~> Check if user has selected more than one cell
If Target.Cells.CountLarge < 1 Then Exit Sub
If Target.Cells.CountLarge > 500 Then Exit Sub
Debug.Print CStr(Target.Cells.CountLarge)
Application.EnableEvents = False
Dim the_row As Range
Dim the_range As Range
Set the_range = Target
'~~> Check if the user made any changes in Col A
If Not Intersect(the_range, Columns(1)) Is Nothing Then
For Each the_row In the_range.Rows
'~~> Ensure it is not in row 2
If the_row.Row > 2 Then
'~~> Write to relevant cell in Col H
Range("H" & the_row.Row).Value = Now
End If
Next
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
I wrote a simple macro
=IF(C2=H2,1,))
so whenver value of C2 equals value of H2, pop up window saying "HI" appears
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rng As Range
Set rng = Range("H2")
If Not Intersect(Target, rng) Is Nothing Then
If rng = "1" Then
MsgBox "Cell " & _
rng.Address & " = hi"
End If
End If
Set rng = Nothing
End Sub
The problem is that I need it to make sound as well as pop-up and more importantly I need it to do it for a 1000 rows(ie. c2,c3,c4 so to c1000).
Don't tell me I need to paste and copy thousand time.
It is hard to understand what exactly you are trying to accomplish because your question is not very clear. If I understood correctly, when a value is changed in column H you would like to check to see if it matches the corresponding cell in column C. If the values match you want to display a message box and play a sound. This code will do exactly that. If I have misunderstood the goal please clarify and I will do what I can to help.
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
If Target.Column = 8 Then
If Target.Value = Target.Offset(0, -5).Value Then
Beep
MsgBox "Cell " & Target.Address(False, False) & " = Hi"
End If
End If
On Error GoTo 0
End Sub
Try this
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Range("C2:C1000")) Is Nothing Then
If Target.Value = Target.Offset(, 5).Value Then
Beep
MsgBox "Blah Blah"
End If
'~~> Added Code to handle changes in Col H as well. Thanks to ripster
ElseIf Not Intersect(Target, Range("H2:H1000")) Is Nothing Then
If Target.Value = Target.Offset(, -5).Value Then
Beep
MsgBox "Blah Blah"
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
I would always recommend using proper error handling. You might also want to see this?
The above code doesn't handle the situation if there is a multiple paste. Let me know if you want to check for that as well :)