Forum Discussion
Apply Validation in a Column D as soon as the Value is Selected in adjacent cell in Column C
Dear Experts,
I request a VBA or Non-VBA solution to the following issue.
As soon as a Value is selected in Column C (Bank Payment ID) of the TABLE "BankPymtDet"
--validation is applied to adjacent cell in Column D of the same table
--List named "PayeeDetails" starts to appear in that cell
--width of the column D should increase to 60 points.
Now as soon as a value is selected from that list
--selected value is splitted in 6 columns using - (hyphen) as the delimiter and all the columns as Text type
--Validation is delected from that cell in Column D
--width of column D is restored to Auto Fit
If there is already some value present in adjacent cell in Column D, then nothing is supposed to happen. Macro to add Validation list and other steps should trigger only if the adjacent cell in Column D is blank.
New version:
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range If Target.CountLarge > 1 Then Exit Sub Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Bank Payment ID").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" And rng.Offset(0, 1).Value = "" Then Application.EnableEvents = False rng.Offset(0, 1).Validation.Delete rng.Offset(0, 1).Validation.Add _ Type:=xlValidateList, _ Formula1:="=PayeeDetails" rng.Offset(0, 1).ColumnWidth = 60 Application.EnableEvents = True End If End If Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Name of Payee").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" Then Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False rng.Validation.Delete rng.TextToColumns _ DataType:=xlDelimited, _ Tab:=False, _ Semicolon:=False, _ Comma:=False, _ Space:=False, _ Other:=True, OtherChar:="-", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2)) rng.EntireColumn.AutoFit Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End If End If End Sub
4 Replies
Right-click the sheet tab.
Select View Code from the context menu.
Copy the code listed below into the worksheet module.
Switch back to Excel.
Save the workbook as a macro-enabled workbook (*.xlsm).
Make sure that you allow macros when you open it.
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range If Target.CountLarge > 1 Then Exit Sub Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Bank Payment ID").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" And rng.Offset(0, 1).Value = "" Then Application.EnableEvents = False rng.Offset(0, 1).Validation.Delete rng.Offset(0, 1).Validation.Add _ Type:=xlValidateList, _ Formula1:="=PayeeDetails" rng.Offset(0, 1).ColumnWidth = 60 Application.EnableEvents = True End If End If Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Name of Payee").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" Then Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False rng.Validation.Delete rng.TextToColumns Other:=True, OtherChar:="-" rng.EntireColumn.AutoFit Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End If End If End SubInstead of splitting the text on the basis of - (hyphen) it is using SPACE as the delimiter ?
New version:
Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range If Target.CountLarge > 1 Then Exit Sub Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Bank Payment ID").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" And rng.Offset(0, 1).Value = "" Then Application.EnableEvents = False rng.Offset(0, 1).Validation.Delete rng.Offset(0, 1).Validation.Add _ Type:=xlValidateList, _ Formula1:="=PayeeDetails" rng.Offset(0, 1).ColumnWidth = 60 Application.EnableEvents = True End If End If Set rng = Intersect(Me.ListObjects("BankPymtDet").ListColumns("Name of Payee").DataBodyRange, Target) If Not rng Is Nothing Then If rng.Value <> "" Then Application.ScreenUpdating = False Application.EnableEvents = False Application.DisplayAlerts = False rng.Validation.Delete rng.TextToColumns _ DataType:=xlDelimited, _ Tab:=False, _ Semicolon:=False, _ Comma:=False, _ Space:=False, _ Other:=True, OtherChar:="-", _ FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), Array(6, 2)) rng.EntireColumn.AutoFit Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End If End If End Sub
