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
Related
I am trying to link 2 cells that have data validation lists in them so that when 1 of the cells (ex. cell A2) is filled with the SKU in from a selection in the dropdown list, cell B2 will be filled with the SKU description and vice versa.
See the pictures below with that I have so far. I have named the columns:
Column A = a_val
Column B = b_val
SKU column with values = vrac
SKU description column with values = vrac_description
Table with SKUs and SKU descriptions = description
See the attached pictures for what I currently have.
1 sheet is the empty fields, I have data validation lists on columns A and B since I want to be able to have the option to select either from column A or column B but would like either one to auto-populate when I've selected an item from the list in the opposite cell
Thank you!
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a_val")) Is Nothing Then
With Application.WorksheetFunction
UI False
Range("b_val").Value = .Index(Range("vrac_description").Value, .Match(Range("a_val").Value, Range("description").Value, 0))
UI True
End With
ElseIf Not Intersect(Target, [b_val]) Is Nothing Then
With Application.WorksheetFunction
UI False
[a_val].Value = .Index([vrac], .Match([b_val], [vrac_description], 0))
UI True
End With
End If
End Sub
Public Sub UI(t As Boolean)
Application.EnableEvents = t
Application.ScreenUpdating = t
End Sub
Current Code
Main Sheet
Data Validation Lookup
[EDIT} New code attempt:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, a_val) Is Nothing Then
With Application.WorksheetFunction
UI False
'b_val = .VLookup(Target, Description, 1, 0)
Range(Target.Column + 1).Value = .Index(vrac_description, .Match(Target.Value, vrac, 0))
UI True
End With
ElseIf Not Intersect(Target, b_val) Is Nothing Then
With Application.WorksheetFunction
UI False
'Range(Target.Column - 1).Value = .VLookup(Target.Value, Description, 1, 0)
Range(Target.Column - 1).Value = .Index(vrac, .Match(Target.Value, vrac_description, 0))
UI True
End With
End If
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Msgbox "Target=" & Target.Address
On Error GoTo errorexit
Dim r, i As Long, cell As Range
i = Target.Column
If i > 2 Or Target.Value = "" Then Exit Sub
Set cell = Target.Offset(, 3 - i * 2)
With Sheets("Data_Validation").ListObjects("description").DataBodyRange
r = Application.Match(Target.Value, .Columns(i), 0)
If Not IsError(r) Then
Application.EnableEvents = False
cell = .Cells(r, 3 - i).Value
Else
MsgBox Target.Value & " not found in column " & i
End If
End With
errorexit:
Application.EnableEvents = True
End Sub
Your code corrected
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo exiterror
Dim a_val As Range, b_val As Range
Dim vrac As Range, vrac_description As Range
' define ranges
With ThisWorkbook
Set a_val = .Names("a_val").RefersToRange
Set b_val = .Names("b_val").RefersToRange
Set vrac = .Names("vrac").RefersToRange
Set vrac_description = .Names("vrac_description").RefersToRange
End With
If Not Intersect(Target, a_val) Is Nothing Then
With Application.WorksheetFunction
UI False
Target.Offset(, 1).Value = .Index(vrac_description, .Match(Target.Value, vrac, 0))
UI True
End With
ElseIf Not Intersect(Target, b_val) Is Nothing Then
With Application.WorksheetFunction
UI False
Target.Offset(, -1).Value = .Index(vrac, .Match(Target.Value, vrac_description, 0))
UI True
End With
End If
exiterror:
Application.EnableEvents = True
End Sub
I am a first time poster and a newby to VBA. So i am hoping i make sense :)
I am trying to combine 3 private subs, but not sure how to code it together.
I have a spreadsheet that has data validation and i want a input box to appear depending on what is selected.
In column "I" is the first set of data validation, with the options of Accepted, Declined and Null invoid, if "Accepted" then nothing, but if either Declined or Null in Void, I would like a pop up box to appear for the user to input $0, and past that to Column "D"
In Column "M" is the next one for data validation, with the only options is blank and Complete. if blank then nothing, but if Complete, i would like a pop up for the user to input the Quotation value, and past that to Column "D".
Thank you in advance.
This is my code
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Declined" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to 0", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Null in Void" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to 0", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M")) Is Nothing Then
If Target = "Complete" Then
roww = Target.Row
Application.EnableEvents = False
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value to the Quotation Value", Type:=2)
Application.EnableEvents = True
End If
End If
End Sub
Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M:M")) Is Nothing Then
If Target = "Complete" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To the Quotation Value", Type:=2)
Application.EnableEvents = TRUE
End If
ElseIf Not Intersect(Target, Range("I:I")) Is Nothing Then
If Target = "Declined" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To 0", Type:=2)
Application.EnableEvents = TRUE
ElseIf Target = "Null in Void" Then
roww = Target.Row
Application.EnableEvents = FALSE
Cells(roww, "D").Value = Application.InputBox(Prompt:="Updated quoted value To 0", Type:=2)
Application.EnableEvents = TRUE
End If
End If
End Sub
see this official docs.
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
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 cell A1, cell B1 and cell C1, I need check if value changed in A1 by user or by VBA. Whith out If statment on Target.Address A1 makes infinite loop
Private Sub Worksheet_Change(ByVal Target As range)
If Target.Address = B1 or Target.Address = C1 Then
If IsEmpty(Cell("B1")) then
Cell("A1").value = "Enter value"
If IsEmpty(Cell("C1")) then
Cell("A1").value = ""
Else
Cell("A1").value = "=C1/B1"
End IF
End IF
End IF
If Target.Address = A1
IF "changed by user typing" Then
Cell("B1").value = ""
Cell("C1").value = ""
Else
End IF
End IF
End Sub
How to determine what Target was changed by user not from VBA?
I suspect you want something like this:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
Range("B1:C1").Value = ""
Application.EnableEvents = True
ElseIf Not Intersect(Target, Range("B1:C1")) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(Range("B1")) Then
Range("A1").Value = "Enter value"
ElseIf IsEmpty(Range("C1")) Then
Range("A1").Value = ""
Else
Range("A1").Value = "=C1/B1"
End If
Application.EnableEvents = True
End If
End Sub