I have two tables. Both tables are the same size, located in columns I:X and AB:AQ (offset by 19 columns start-to-start).
I want when I enter a number in a cell within the left table, to go 19 columns to the right after pressing enter. Then, once entering text into the active cell in the right table, return 19 cells to the left table.
I found this question/answer, but I wasn't able to apply it.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
Application.EnableEvents = False
If Not Target.Cells.CountLarge > 1 Then
If Not Intersect(Target, Columns(9)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(10)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(11)) Is Nothing Then
Target.Offset(, 19).Select
ElseIf Not Intersect(Target, Columns(12)) Is Nothing Then
Target.Offset(, 19).Select
'etc...
ElseIf Not Intersect(Target, Columns(42)) Is Nothing Then
Target.Offset(, -19).Select
ElseIf Not Intersect(Target, Columns(43)) Is Nothing Then
Target.Offset(, -19).Select
End If
End If
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
As an alternative, if it can recognize that the cell entered is within columns I:X and just offset 19 columns after pressing enter (and then the reverse), this would be fine.
A second alternative, if it is easier, changing the function of the Page Up and Page Down keys, I would not need to check which column I am in.
Lastly, this should only work on a particular sheet Tracking.
Something like this should work for you. Make sure the code is in the 'Tracking' worksheet code module:
And here is the code you would use:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngChange1 As Range
Dim rngChange2 As Range
Set rngChange1 = Range("I:X")
Set rngChange2 = Range("AB:AQ")
Application.EnableEvents = False
If Not Intersect(rngChange1, Target) Is Nothing Then
Target.Offset(, 19).Value = Target.Value
End If
If Not Intersect(rngChange2, Target) Is Nothing Then
Target.Offset(, -19).Value = Target.Value
End If
Application.EnableEvents = True
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
I would like to add an additional '-' sign to the value in the Hours column if the status is changed from 'Pending' to 'Completed'.
I tried the "Worksheet_Change" event but I do not see any changes in my worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C5:C14")) Is Nothing Then Exit Sub
Application.EnableEvents = False
With Intersect(Range("C5:C14"), Target)
.Offset(, -1).Value = -.Offset(, -1).Value
.ClearContents
End With
Application.EnableEvents = True
End Sub
if any cell in column k has a value of "Yes" then offset (0,1) become empty,
Else if any cell in column k has a value of "No" then offset (0,2) become empty.
The problem is that the event is not firing. The code is placed in the worksheet.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("k:k")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim Cell As Range
For Each Cell In Intersect(Target, Range("k:k"))
If Cell.Value = "Yes" Then
Cell.Offset(0, 1).ClearContents
ElseIf Cell.Value = "No" Then
Cell.Offset(0, 2).ClearContents
End If
Next Cell
End If
safe_exit:
Application.EnableEvents = True
End Sub
The Code were correct. While debugging "The current state" of Application.EnableEvents was not switched back to enabled. Thanks everyone for the contributions. CLR & Tim Williams
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 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