Trying to get excel to mirror columns, at the moment I'm using the code below, to update 2 cells based on each other, ideally I'd like to expand this so that any changes to a cell within D24:D100 affects the neighbouring cell within E24:E100 - can anyone help?
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Application.EnableEvents = False
If Target.Address = "$D$24" Then
Range("$E$24").Value = (Target.Value) * 1.11
ElseIf Target.Address = "$E$24" Then
Range("$D$24").Value = (Target.Value) / 1.11
End If
Application.EnableEvents = True
End Sub
Try this code, please:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Not Intersect(Target, Range("D24:E100")) Is Nothing Then
Application.EnableEvents = False
If Target.Column = 4 Then
Target.Offset(0, 1).Value = Target.Value * 1.11
ElseIf Target.Column = 5 Then
Target.Offset(0, -1).Value = Target.Value / 1.11
End If
Application.EnableEvents = True
End If
End Sub
Related
Is there a possibility that the two codes below can be combined to so that if the checkbox is selected and the D11 cell has a specific selection then it would hide columns based on the two selections?
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$11" Then
If Target.Value = "A" Or Target.Value = "C" Then
Sheets("Worksheet").Columns("BL:CH").Hidden = True
ElseIf Target.Value = "C" Then
Sheets("Worksheet").Columns("BL:BY").Hidden = False
End If
End If
End Sub
Private Sub CheckBox1_Click()
Sheets("Worksheet").Columns("BZ:CH").Hidden = Not Me.CheckBox1.Value (TO UNHIDE SPECIFIC COLUMS ONLY WHEN CHECKED)
End Sub
This is what I got to work. Thank you
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$11" Then
If Target.Value = "A" Or Target.Value = "B" Then
Sheets("Worksheet").Columns("BL:CH").Hidden = True
ElseIf Target.Value = "C" And Not Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = False
ElseIf Target.Value = "C" And Me.CheckBox1.Value Then
Sheets("Worksheet").Columns("BL:BY").Hidden = True
Sheets("Worksheet").Columns("BZ:CH").Hidden = False
End If
End If
End Sub
I have a code that fills the date in column 3 when the there is a change in values of a cell Range("E:J"). It works fine, but I would also like to display the values of column 4 (col 4 is hidden) in column 11, only when all the cells in the Range(E:J) are filled.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("E:J")) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target.Value <> vbNullString Then
Target.Offset(0, 3 - Target.Column).Value = Date
Target.Offset(0, 3 - Target.Column).NumberFormat = "dd/mmm/yyyy"
Else
Target.Offset(0, 3 - Target.Column).ClearContents
End If
Application.EnableEvents = True
End Sub
Any help on this would be greatly appreciated.
Thanks.
Consider:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tc As Long, r As Range, tr As Long
Dim wf As WorksheetFunction
Set wf = Application.WorksheetFunction
If Target.Count > 1 Then Exit Sub
tc = Target.Column
tr = Target.Row
If Intersect(Target, Range("E:J")) Is Nothing Then Exit Sub
Set r = Range(Cells(tr, "E"), Cells(tr, "J"))
Application.EnableEvents = False
If Target.Value <> vbNullString Then
Target.Offset(0, 3 - tc).Value = Date
Target.Offset(0, 3 - tc).NumberFormat = "dd/mmm/yyyy"
Else
Target.Offset(0, 3 - tc).ClearContents
End If
If wf.CountA(r) = 6 Then
Cells(tr, 11).Value = Cells(tr, 4).Value
End If
Application.EnableEvents = True
End Sub
I have an excel worksheet that I want to assign to it more than one Worksheet Event.
To be more specific, I want whenever a cell in column B is changed then one cell to the left (column A) gets the row number.
Also I want whenever a cell in column J is changed then one cell to the right (column K) gets today's date.
It worked for me for both of them individually but I think I may be doing something wrong using them together.
Any help will be much appreciated!
Private Sub AG1(ByVal a_Target As Range)
If Not Intersect(a_Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(a_Target.Row, a_Target.Column - 1) = a_Target.Row
Application.EnableEvents = True
End If
End Sub
Private Sub AG2(ByVal b_Target As Range)
If Not Intersect(b_Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(b_Target.Row, b_Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
edit - works now (I also added that column can be referred as letter):
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "B" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
ElseIf Split(Cells(1, Target.Column).Address(True, False), "$")(0) = "J" Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
Copy the code in the Worksheet_Change event and that should fix your issue. This will trigger every time you enter a value for any cell and will only meet the condition if they intersect the range in the if statement.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("B2:B3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column - 1) = Target.Row
Application.EnableEvents = True
End If
If Not Intersect(Target, Me.Range("J2:J3000")) Is Nothing Then
Application.EnableEvents = False
Cells(Target.Row, Target.Column + 1) = Date
Application.EnableEvents = True
End If
End Sub
I have a VBA like below but when i copy more then 1 cell i get a error because of the multiple selection.
Is it possible to make a action that the Case looks at the selected cells one after the other? Or do i have the wrong Statment?
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("$G$8:$OA$92")) Is Nothing Then
With Target
Select Case .Value
Case Is = "Weekend"
.Interior.ColorIndex = 48
Case Is = "VRIJ", "ADV"
.Interior.ColorIndex = 6
End Select
End With
End If
End Sub
Loop through the cells in the intersect.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G8:OA92")) Is Nothing Then
on error goto meh
application.enableevents = false
dim t as range
for each t in Intersect(Target, Range("G8:OA92"))
With t
Select Case lcase(.Value2)
Case "weekend"
.Interior.ColorIndex = 48
Case "vrij", "adv"
.Interior.ColorIndex = 6
case else
.interior.pattern = xlnone
End Select
End With
next t
End If
meh:
application.enableevents = true
End Sub
I have a worksheet that contains invoice numbers in column D. I'd like to copy the invoice number to another worksheet ("Details") when one is selected. I've added the "If IsNumeric" condition to make sure that only cells containing an invoice # will be copied over. The code seems to do nothing, can anyone help point me in the right direction?
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
On Error Resume Next
Application.EnableEvents = False
If IsNumeric(Target.Value) Then
Sheets("Detail").Range("A5").Value = Target.Value
Application.EnableEvents = True
Sheets("Detail").Activate
End If
End If
End Sub
Rather than:
IsNumeric(Target.Address)
try
IsNumeric(Target)
EDIT#1:
Try this:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
Application.EnableEvents = False
If IsNumeric(Target.Value) Then
Target.Copy Sheets("Detail").Range("A5")
End If
Application.EnableEvents = True
End If
End Sub
EDIT#2:
You need to re-enable events within the same IF
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 4 Then
On Error Resume Next
If IsNumeric(Target.Value) Then
Application.EnableEvents = False
Sheets("Detail").Range("A5").Value = Target.Value
Sheets("Detail").Activate
Application.EnableEvents = True
End If
End If
End Sub