Sheet1
Private Sub Worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("B93")) Is Nothing Then
If Target = Range("B93") Then
Sheets("Sheet2").Range("A1").Value = Target.Value
End If
End If
End Sub
Sheet2
Private Sub Worksheet_change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Target = Range("A1") Then
If Sheets("Sheet1").Range("B93").Value <> Target.Value Then
Sheets("Sheet1").Range("B93").Value = Target.Value
End If
End If
End If
End Sub
The code works for only single cell on B93 and A1.
I tried setting the range to Range("B93:N122") on sheet1 and Range("A1:M22") on sheet 2 to mirror the ranges when changes happened but I get the error 13 mismatch.
Goal: I want to mirror the changes (two way) on range(A1:M22) sheet 1 to sheet 2 vice versa. What line of code am i missing?
Mirror Ranges
Values changed in cells of one worksheet will also change to the same values in the same cells of the other worksheet and vice versa.
Standard Module e.g. Module1
Option Explicit
Sub MirrorWorksheets( _
ByVal Target As Range, _
ByVal RangeAddress As String, _
ByVal WorksheetName As String)
Dim sws As Worksheet: Set sws = Target.Worksheet
Dim irg As Range: Set irg = Intersect(sws.Range(RangeAddress), Target)
If irg Is Nothing Then Exit Sub
Dim dws As Worksheet: Set dws = sws.Parent.Worksheets(WorksheetName)
Application.EnableEvents = False
Dim iarg As Range
For Each iarg In irg.Areas
dws.Range(iarg.Address).Value = iarg.Value
Next iarg
Application.EnableEvents = True
End Sub
Sheet1 Module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
MirrorWorksheets Target, "A1:M22,B93:N122", "Sheet2"
End Sub
Sheet2 Module
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
MirrorWorksheets Target, "A1:M22,B93:N122", "Sheet1"
End Sub
Related
I would like to move to the next line by offsetting from ActiveCell, but it either doesn't work or I get run time error. Maybe this isn't possible within Private Sub Worksheet_Change(ByVal Target As Range), but sure would be nicer for users of this free workbook.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("C4:C400")
If Not Intersect(Target, rng) Is Nothing Then
ActiveWorkbook.Save
Set selectedCell = Application.ActiveCell
ActiveCell.Offset(1, -4).Select
End If
Dim cng As Range
Set cng = Range("A4:A400")
If Not Intersect(Target, cng) Is Nothing Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End Sub
I want to record a list of live data in a separate sheet.
Found this code online which works.
How to do I change the range from one cell A1 to a Range A1:D30?
Private Sub Worksheet_Change(ByVal Target As Range)
Dim dest As Range
Application.EnableAnimations = False
On Error GoTo line1
If Target.Address <> "$A$1" Then GoTo line1
Set dest = Worksheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Offset(1, 0)
'MsgBox dest.Address
Target.Copy dest
line1:
Application.EnableEvents = True
End Sub
This can be done without a custom function. VBA already contains all you need.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:D30")) Is Nothing Then
' run some code
End If
End Sub
I am trying to combine these two codes, the first one is to change the name of my worksheet when I change the value of the cell m3, and the second code is to block the cells after modifying the cells. I am new in VBA so I don't know how to combine them.
CODE 1
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$3" Then RenameSheet
End Sub
CODE 2
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range
On Error Resume Next
Set xRg = Intersect(Range("F6"), Target)
If xRg Is Nothing Then Exit Sub
Target.Worksheet.Unprotect Password:="1234"
xRg.MergeArea.Locked = True
Target.Worksheet.Protect Password:="1234"
End Sub
Also sub renamesheet code is:
Sub RenameSheet()
Dim rs As Worksheet
For Each rs In Sheets
If rs.Name <> "MENU" And rs.Name <> "CAJA_CONTABILIDAD" Then
rs.Name = "Vale " & rs.Range("M3")
End If
Next rs
If Target.Address = "$M$3" Then RenameSheet
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$M$3" Then
RenameSheet
Exit Sub
End If
Dim xRg As Range
Set xRg = Intersect(Range("F6"), Target)
On Error Resume Next
If Not xRg Is Nothing Then
Target.Worksheet.Unprotect Password:="1234"
xRg.MergeArea.Locked = True
Target.Worksheet.Protect Password:="1234"
End If
End Sub
I'm not experienced in VBA and I've pieced together a small script to make the contents of a cell uppercase once any value has been entered. The script should apply this only to a certain range of cells, in my case J11:AK25.
The script works (it makes the contents of a cell uppercase once something is entered or changed), but Excel crashes right after entering or changing a value. This happens in Excel 2013.
The code I have right now:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("J11:AK24")) Is Nothing Then RunUp
End Sub
Sub RunUp()
Range("J11:AK25") = [index(upper(J11:AK25),)]
End Sub
Anyone able to assist?
turn off the events before calling the other sub:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Goto SafeOut
Application.EnableEvents = False
If Not Intersect(Target, Me.Range("J11:AK24")) Is Nothing Then RunUp
SafeOut:
Application.EnableEvents = True
End Sub
That being said, this may be safer:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo SafeOut
Application.EnableEvents = False
Dim rng As Range
Set rng = Intersect(Target, Me.Range("J11:AK24"))
If Not rng Is Nothing Then
Dim cel As Range
For Each cel In rng
cel.Value = UCase$(cel.Value)
Next cel
End If
SafeOut:
Application.EnableEvents = True
End Sub
How can I use the target.value in a label in the Userform? No matter what I've tried I get an error. (Run-time "438": Object doesn't support property or method )
I would like the userform to show when a cell number is changed:
My Worksheet code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("D8:D12")
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
UserForm1.Show
End If
End Sub
My Userform code the way I would imagine it should work (But it doesn't work):
Private Sub UserForm_Initialize()
Label1.Caption = Worksheets("Personal Barrier").Target.Offset(0, -1).Value
End Sub
There is no Target property in Worksheet object. You can set label in Worksheet_Change method:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Set KeyCells = Range("D8:D12")
If Not Application.Intersect(KeyCells, Target) Is Nothing Then
UserForm1.Label1.Caption = Target.Offset(0, -1).Value
UserForm1.Show
End If
End Sub