The code works but It’s only applying to one cell instead of the whole column. The columns I want affected are E and F on my spreadsheet. Any help is appreciated.
I am using the VB code below, The bolded/underlined portion is the part of the code I need help changing.
Private Sub Worksheet_Change(ByVal Target As Range) Dim Oldvalue As String Dim Newvalue As String Application.EnableEvents = True On Error GoTo Exitsub If Target.Address = "$A$10" Or Target.Address = "$D$10" Then If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then GoTo Exitsub Else: If Target.Value = "" Then GoTo Exitsub Else Application.EnableEvents = False Newvalue = Target.Value Application.Undo Oldvalue = Target.Value If Oldvalue = "" Then Target.Value = Newvalue Else If InStr(1, Oldvalue, Newvalue) = 0 Then Target.Value = Oldvalue & vbNewLine & Newvalue Else: Target.Value = Oldvalue End If End If End If End If Application.EnableEvents = True Exitsub: Application.EnableEvents = True End Sub
Thank you in advance!
I'm not sure why you say the columns you want affected are E & F, yet your code is affecting A & D, however, if the below does what you need you should be able to easily amend it to the correct columns.
BSB
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
On Error GoTo Exitsub
If Target.Row >= 10 Then
If Not Intersect(Target, Range("A:A,D:D")) Is Nothing Then
If Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
GoTo Exitsub
Else
If Target.Value = "" Then
GoTo Exitsub
Else
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else
Target.Value = Oldvalue
End If
End If
End If
End If
End If
End If
Exitsub:
Application.EnableEvents = True
End Sub
Or this to get rid of the "Exitsub" element of it.
BSB
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Oldvalue As String
Dim Newvalue As String
Application.EnableEvents = True
If Target.Row >= 10 Then
If Not Intersect(Target, Range("A:A,D:D")) Is Nothing Then
If Not Target.SpecialCells(xlCellTypeAllValidation) Is Nothing Then
If Target.Value <> "" Then
Application.EnableEvents = False
Newvalue = Target.Value
Application.Undo
Oldvalue = Target.Value
If Oldvalue = "" Then
Target.Value = Newvalue
Else
If InStr(1, Oldvalue, Newvalue) = 0 Then
Target.Value = Oldvalue & vbNewLine & Newvalue
Else
Target.Value = Oldvalue
End If
End If
End If
End If
End If
End If
Application.EnableEvents = True
End Sub
