Apply Validation in a Column D as soon as the Value is Selected in adjacent cell in Column C

[KanwalNo1]

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.

[#2]

@KanwalNo1 

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 Sub

[#3]

Instead of splitting the text on the basis of - (hyphen) it is using SPACE as the delimiter ?

[#4 · Accepted solution]

@KanwalNo1 

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

[#5]

Thanks a Lot Hans !
It was lightening quick ! Looks to be doing fine at the moment.
Let me use the code in actual scenario.

Thank You So much Sir !
Sincere Regards
Kanwaljit