I'm looking for some help please with some VBA.
Let's say I have a range of cells (B4:B12), so if I input data in a cell within the range I would like to clear all cells in the same range except for the cell in which I inputed the data. So that I can only have 1 cell with data in the range.
So if B5 had data and I inputed data in B7 then B5 would clear, then if i entered data in B10 then B7 would clear...
I hope there is a solution as I have been trying to find an answer for the past couple of hours.
I would do it this way:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set myRange = Sh.Range("B4:B12")
'set the current cell/address/value so we don't lose them when the range is cleared
Set cell = Sh.Range(Target.address)
value = Target
'disable/enable so this isn't called every time a cell is cleared
'clear the range then reset the to entered value
If Not Intersect(Target, myRange) Is Nothing Then
Application.EnableEvents = False
myRange.Clear
cell.value = value
Application.EnableEvents = True
End If
End Sub
Or you could use worksheet event to bevplaced in the relevant worksheet code pane
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myVal As Variant
With Range("B4:B12") ‘reference your range
If Not Intersect(Target, .Cells) Is Nothing And Target.Count = 1 Then ‘ if changed range is one cell within the referenced one
myVal = Target.Value ‘store changed cell value
Application.EnableEvents = False
.ClearContents ‘ clear the content of referenced range
Target.Value = myVal ‘ write changed cell value back
Application.EnableEvents = True
End If
End With
End Sub
Related
I'm trying to make a code which after insert/update value in one cell, will go to the next cell like on the picture. Now this code works only one way:
ActiveCell.Offset(1,0).Select ex. from A2 to B2.
What to do to return offset to the cell on the left from B2 to A3 - need loop like on the picture.
I am not quite sure if I understood what you are looking!
I set a range on column A and B until row 10, just for testing.
This code moves to the next cell on the picture whenever you edit
the cell and then you press Enter.
Put this code on the sheet module
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngColA As Range: Set rngColA = Range("A2:A10")
Dim rngColB As Range: Set rngColB = Range("B2:B10")
If Not Intersect(Target, rngColA) Is Nothing Then
Target.Offset(0, 1).Select
exit sub
End If
If Not Intersect(Target, rngColB) Is Nothing Then
Target.Offset(1, -1).Select
End If
End Sub
I want to add a value to a cell based on another with VBA but I'm not sure how. I already searched on internet about it but can't find anything.
I have a table, and on the Column C, if any cell contains the text "MAM" (because it might have MAM-565), then change the value from Cell A to "Wrong", but if it contains "NAC", then change value to "Correct". It should be in the same row as the text found.
Also, I want to add the date automatically to cell E every time Cell in D is filled.
This the code I have already:
Private Sub Worksheet_Change(ByVal Target As Range)
'Add Issue Type'
Dim Code As Range
Set Code = Range("C2:C100000")
For Each Cell In Code
If InStr(1, Cell, "NAC") Then
Range("A2:A10000").Value = "Correct"
ElseIf InStr(1, Cell, "MAM") Then
Range("A2:A10000").Value = "Wrong"
End If
Next
End Sub
This how my table looks like:
Table
Thanks in advance guys :)
To automatically add the datestamp:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng as Range
Set rng = Intersect(Target, Me.Range("D:D"))
If rng Is Nothing Then Exit Sub
On Error GoTo SafeExit
Application.EnableEvents = False
Dim cell as Range
For Each cell in rng
If Not IsEmpty(cell) Then ' don't do anything if cell was cleared
cell.Offset(,1).Value = Date
End If
Next
SafeExit:
Application.EnableEvents = True
End Sub
As far as the Correct/Wrong, this can easily be done with a formula (ISNUMBER(SEARCH(...)). I don't see the need for VBA here.
Even better, create a table using Ctrl+T. Excel will automatically add the formula in column A in new rows.
I'm trying to disable the range of cells on another sheet ( say Sheet4) based on the value in the current sheet(say Sheet1)
I have tried to disable the values in the sheet4("M4,M6,M8,M10,M12") based on the values in sheet1("C5") by using worksheet change function.
With Sheet1 I have used the below code and getting the error message
Subscript Out of Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myRng As Range
Dim Cancel As Boolean
If Not Intersect(Target, Me.Range("C5")) Is Nothing Then
Set myRng = ThisWorkbook.Worksheets("Sheet4").Range("M4,M6,M8,M10,M12")
Me.Unprotect Password:=SHEET_PASSWORD
If Me.Range("C5").Value = "Yes" Then
myRng.Locked = False
Else
myRng.Locked = True
ThisWorkbook.Worksheets("Sheet4").Range("M4,M6,M8,M10,M12") = ""
End If
Me.Protect Password:=SHEET_PASSWORD
End If
End Sub
If I choose "Yes" in the cell value C5 in Sheet1, the cell values (M4,M6,M8,M10,M12) in sheet4 should be enabled. If i choose "No" in the cell value C5 in Sheet1, the cell values (M4,M6,M8,M10,M12) in sheet4 should be disabled.
I think This is what you are looking For.
Private Sub Worksheet_Change(ByVal Target As Range)
If ChangeEventFlag = 0 Then
Dim myRng As Range
Dim Cancel As Boolean
If Not Intersect(Target, Me.Range("C5")) Is Nothing Then
With ThisWorkbook.Worksheets("Sheet4")
.Unprotect Password:="password"
.Cells.Locked = False
Set myRng = .Range("M4,M6,M8,M10,M12")
If Me.Range("C5").Value = "Yes" Then
myRng.Locked = False
Else
myRng.Locked = True
myRng.Value = ""
End If
.Protect Password:="password"
End With
End If
End If
End Sub
Note:
Not sure about the use of ChangeEventFlag
Change the Password, I used password for testing
Use:
Whichever sheet you will paste this code on will Lock Range("M4,M6,M8,M10,M12") of Sheet4 if it's C5 is No(Anything Other Than Yes Actually) and will unlock it if C5 is Yes
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 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