naming a range for column 'H' in excel using VBA

[Patriot2879]

Hi i have the code below but this works for all of sheet1 and i only want the code to working in column H and down only please can you help for example .Range("H") but i dont know the exact code or where to put it, and i want it to work on new line as well when data entered. I hope you can help. many thanks

Private Sub Worksheet_Change
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Cells.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

EDIT: i forgot to add it will be for thisworkbook and sheet1 column H and down only, hope this helps. thanks again for your time looking at this

thank you

 

[Patriot2879]

Hi good morning, just wondering if you could help me on the above query please, the line but i dont know how to add exactly is something like .... thisworkbook.sheet (Sheets1).Range ("H)... but i dont know where to add and what it will replace in the code if you can help please?

 

[Fluff]

Try

 Set xRng = Columns(8).SpecialCells(xlCellTypeAllValidation)

 

[Patriot2879]

hi thx for the code but it still does the same thing as before where it works in all the cells and not just in column H, hope you can still help, it is appreciated

 

[Fluff]

What is your code now?

 

[Patriot2879]

Hello, thanks for your response the code i am using now is

Private Sub Worksheet_Change
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Columns(8).SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub

 

[RoryA]

That is not the proper declaration for a Worksheet_Change event.

 

[Patriot2879]

sorry i dont know what you mean. the code is added at the moment in sheet1, and on sheet1 there is a dropdown box where the data is collated from sheet 2 for example (mon, Tues, Weds, Thurs, Fri), where the user will select a day and i want the code for the user to be able to select multiple days, for example one day they select Mon then the next day they want to add a day, for example Mon, Tues then the code will show both in the cell in column H.

 

[Fluff]

Good spot Rory.
@Patriot2879
it should be

Private Sub Worksheet_Change(ByVal Target As Range)

and the code should be in the sheet module

 

[Patriot2879]

so i just need to change it to the following? thank you for your help.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    If Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Set xRng = Columns(8).SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Not Application.Intersect(Target, xRng) Is Nothing Then
        xValue2 = Target.Value
        Application.Undo
        xValue1 = Target.Value
        Target.Value = xValue2
        If xValue1 <> "" Then
            If xValue2 <> "" Then
                If xValue1 = xValue2 Or _
                   InStr(1, xValue1, ", " & xValue2) Or _
                   InStr(1, xValue1, xValue2 & ",") Then
                    Target.Value = xValue1
                Else
                    Target.Value = xValue1 & ", " & xValue2
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End Sub