This is a simple answer but one I cannot find.
I have two columns of data.
Column A (1) has yes/no data validation list options in every cell.
Column B also has data validation with say 6 strings of text options in every cell.
But I only want each the corresponding cell (column B) to update in the same row as column A
e.g A20 toggled, then B20 is updated. Like so
A20 is selected “Yes” from the dropdown option and B20 is updated with the string “complete” which is one of the states you can select in the dropdown boxes manually in every cell in column B.
I had some code but I would have to write an argument for every cell and then two macros for every yes / no.
This is code that works for one cell only but this is not ideal for many cells but it works
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A20")) Is Nothing Then
Select Case Range("A20")
Case "Yes": Macro_001
Case "No": Macro_002
End Select
End If
End Sub
Sub Macro_001()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("August 2020").Select
Sheets("August 2020").Range("B20").Select
ActiveCell.FormulaR1C1 = "Complete"
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
Sub Macro_002()
Application.Calculation = xlManual
Application.ScreenUpdating = False
Sheets("August 2020").Select
Sheets("August 2020").Range("B20").Select
ActiveCell.FormulaR1C1 = ""
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub
There much be an easier way with .range perhaps
Thanks in advance
In the developer tab click view code, choose the sheet you want the macro to run on, make sure the upper left drop down says worksheet and the upper right says Change (I'll assume your sheet has headers):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim ChangeCell As Range
Dim numrows As Long
numrows = Cells(Rows.Count, 1).End(xlUp).Row
Set TriggerCells = Range("A1")
Set KeyCells = Range("B2:B" & numrows)
If Application.Intersect(TriggerCells, Range("A1")) = "[Column Header Text]" Then
If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
If Target.Value = "Yes" Then
Range("B" & Target.Row).Value = "Completed"
End If
End If
End If
End Sub
Try that, see if it works for you.
Related
How do I render any cell in range ("A1:A10") uneditable (cannot be changed) if there is any content in 2 cells to the right (same row, column C), and make that cell editable again once the cell in same row column C becomes empty.
I tried the code below but it has no effect, i can still edit the cells in col A even with content in col C. Ideally I would like to have it done without protecting sheet.
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C10")) Is Nothing Then
If Target.Value <> "" Then
Target.Offset(0, -2).Cells.Locked = True
ActiveSheet.Protect Contents:=True
End If
Application.EnableEvents = True
End If
End Sub
Thank you,
Jay
Option Explicit
'*** Note: I need to reside in the Sheet Module for the
' sheet I am working on!
'*** Note: Make sure the Locked flags for A1:A10 and
' C1:C10 are cleared before implementing.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Application.EnableEvents = False 'Turn off Events to prevent loop!
If Not Intersect(Target, Range("C1:C10")) Is Nothing Then
ActiveSheet.Unprotect 'You need to unprotect before proceeding
For Each rng In Target
If rng <> "" Then 'Checking for Target.Address will always have a value!
rng.Offset(0, -2).Locked = True
Else
rng.Offset(0, -2).Locked = False
End If
Next rng
ActiveSheet.Protect Contents:=True 'Turn Protection back on
'*** If you have other protected elements DrawingObjects and/or Scenarios
' you need to include in line above.
End If
Application.EnableEvents = True 'Re-enable Events
End Sub 'Worksheet_Change
HTH
You are checking Target.Address on being an empty string. Why? Shouldn't that be Target.Value?
In top of this, what's going wrong? Did you debug the code, using breakpoints? What did you see? ... In case my answer does not satisfy your needs, please edit your question and add the needed information.
New user, was referred to your helpful website by a friendly team member.
Problem: Trying to force a user in excel to fill in a cell in a column (column O) before filling in a cell in columns I-L. The problem lies in that not every cell in the columns needs to be filled in. I've found a VBA code that has somewhat helped but the problem is the pop up will still occur if column O is filled before there is text in just one of the cells in column I-L (and therefore the error occurs unless all 4 cells in the row are filled in). As mentioned, the goal is (for example) to get O264 to be filled in first before any of the cells in column I,J,K or L264 are filled in.
Further exacerbating this issue is there are multiple rows I need this applied to, believe this is where the range fits in. However, playing with the range line in excel does not work in the way I've tried.
Code below:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:L")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Target.Offset(, -1).Value = "" Then
MsgBox "You must first enter feedback in column ""O"""
Target.Value = ""
Target.Offset(, -1).Select
End If
End If
End Sub
This could be a case where you might need to aid the user a little more. You could do that by hiding the dependent cells, by locking them, by greying them out, etc. My feeling is that displaying a message box whenever a user enters data in the wrong order is a little too reactive.
In the example below, the target cells are locked and greyed until something is entered in column 'O'. You'd also need to create a list of target rows if you have more than one.
In your code behind the appropriate sheet, the skeleton code below should get you started. I've included a couple of helper functions to make the code a little clearer for you:
Option Explicit
Private Const SHEET_PASSWORD As String = "xyz" 'whatever password you choose.
Private Const TARGET_ROWS As String = "2,4,6" 'your target rows, separated by commas.
Private Const TARGET_COLUMN As String = "O"
Private Const DEPENDENT_COLUMNS As String = "I:L"
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell As Range
Set rng = Intersect(Target, Me.Columns(TARGET_COLUMN))
'Exit routine if we're not in the target column.
If rng Is Nothing Then Exit Sub
'Process the target column cells.
For Each cell In rng.Cells
If IsTargetRow(cell.Row) Then
SetDependentStates cell
End If
Next
End Sub
Private Sub SetDependentStates(cell As Range)
Dim DependentRange As Range
'Define the Dependent range based on passed cell row.
Set DependentRange = Intersect( _
cell.EntireRow, _
Me.Range(DEPENDENT_COLUMNS) _
)
'Lock/unlock and paint Dependent rows, based on
'contents of passed cell.
Application.EnableEvents = False 'prevent capture of change event.
Me.Unprotect SHEET_PASSWORD
With DependentRange.Cells
If Len(cell.Value) = 0 Then
.ClearContents
.Locked = True
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Else
.Locked = False
With .Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
End With
Me.Protect SHEET_PASSWORD
Me.EnableSelection = xlUnlockedCells
Application.EnableEvents = True
End Sub
Private Function IsTargetRow(rowNum As Long) As Boolean
Dim v As Variant
'Tests if the pass row number is in the target row list.
For Each v In Split(TARGET_ROWS, ",")
If CLng(v) = rowNum Then
IsTargetRow = True
Exit Function
End If
Next
End Function
Public Sub InitialiseDependentStates()
Dim v As Variant
Dim cell As Range
'Define your unlocked cells.
'This is a simple example, adjust as you wish.
With Me
.Unprotect SHEET_PASSWORD
.Cells.Locked = False
.Protect SHEET_PASSWORD
.EnableSelection = xlUnlockedCells
End With
For Each v In Split(TARGET_ROWS, ",")
Set cell = Me.Range(TARGET_COLUMN & v)
SetDependentStates cell
Next
End Sub
You'll likely want to initialise the dependent states when the workbook is opened. Do this in the code behind the Workbook:
Private Sub Workbook_Open()
Sheet1.InitialiseDependentStates 'use whichever sheet you're using.
End Sub
I have rows from 1-100.
I know how to target specific cells and get data from them, but how would I do this when any row from 1 to 100 can be changed?
Say you put anything into Row A3. How would you write "Updated" into row B3 via VBA?
I want this to apply to rows A1-A100.
Thanks
Place the following event macro in the worksheet code area:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A As Range, Intersection As Range, Cell As Range
Set A = Range("A1:A100")
Set Intersection = Intersect(Target, A)
If Intersection Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each Cell In Intersection
Cell.Offset(0, 1).Value = "Updated"
Next Cell
Application.EnableEvents = True
End Sub
Open VBA Editor
Double click on the sheet you event take action (sheets appears in the left top box)
Select Worksheet on the left box above code box
Select change on the right box above code box
Paste the code
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Worksheets("Sheet1")
If Not Intersect(Target, .Range("A1:A100")) Is Nothing Then
Application.EnableEvents = False
.Range("B" & Target.Row).Value = "Updated"
Application.EnableEvents = True
End If
End With
End Sub
I have a working macro that hides/unhides specific columns based off specific values in Column B. I also want to add another trigger that takes the user to the most recently used row. Below is my attempt.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:B")) Is Nothing Then
On Error GoTo safe_exit
Application.EnableEvents = False
Dim t As Range
For Each t In Intersect(Target, Range("B:B"))
Select Case (t.Value)
Case "A"
Columns("B:BP").EntireColumn.Hidden = False
Columns("H:BL").EntireColumn.Hidden = True
Case "B"
Columns("B:BP").EntireColumn.Hidden = False
Columns("F:G").EntireColumn.Hidden = True
Columns("P:BP").EntireColumn.Hidden = True
End Select
Next t
End If
safe_exit:
Application.EnableEvents = True
'Go to last cell in column B
With ActiveSheet
Range("B5").Select
Selection.End(xlDown).Select
End With
End Sub
Perhaps I misread your question from the other answer - and if so, I will be more than happy to delete this one.
You can simply add a variable that will track this for you and persist as long as you keep Excel open.
Private lastUsedRng As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Set lastUsedRng = Target
. . .
...that takes the user to the most recently used row
You can accomplish this with
lastUsedRng.Select
Use Select as little as possible, and replace the last section starting with 'Go to last cell in column B with something like this, except moving it inside the If...End If.
With Me
.Cells(.Rows.Count, 2).End(xlUp).Select
End With
I am searching for a solution in excel. My goal is to enter a value in two different sheets but this value is the same in condition that if we change a value in any of these two sheets it will change automatically in the second one. So I can't use the =(reference to the cell) because it will create the link in one way.
Hope to find a solution.
This would do the trick. If I change the value of cell A1 in Sheet1, the value of cell A1 in Sheet2 is set be equal to that of A1 in Sheet1 and vice versa.
Past this code into Sheet1 in the VBA Editor. Then copy this code and also past this into Sheet2 - change "Sheet2" into "Sheet1" in the code (on line 15)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Changed As Range
Dim vNew As String
Set Changed = Range("A1")
Application.ScreenUpdating = False
Application.EnableEvents = False
If Not Intersect(Target, Changed) Is Nothing Then
vNew = Target.Value
Worksheets("Sheet2").Range("A1") = vNew
ActiveCell.Offset(1, 0).Select
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
Set Changed = Nothing
End Sub