Remove || (pipes) at the end of text inside a column

A simple formula can solve your requirements

=IF(RIGHT(TRIM(A1),2)="||",LEFT(TRIM(A1),LEN(TRIM(A1))-2),A1)

The above formula is based on the below logic.

1. Check if the right 2 characters are ||
2. If "Yes", then take the left characters (LEN - 2)
3. If "No", then return the string as it is.

If you still want VBA then try this code which will make the change in the entire column in one go. Explanation about this method is given HERE.

For demonstration purpose, I am assuming that the data is in column A of Sheet1. Change as applicable.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range
    Dim sAddr As String
    
    Set ws = Sheet1
    
    With ws
        lrow = .Range("A" & .Rows.Count).End(xlUp).Row
        
        Set rng = .Range("A1:A" & lrow)
        sAddr = rng.Address
        
        rng = Evaluate("index(IF(RIGHT(TRIM(" & sAddr & _
                              "),2)=""||"",LEFT(TRIM(" & sAddr & _
                              "),LEN(TRIM(" & sAddr & _
                              "))-2)," & sAddr & _
                              "),)")
    End With
End Sub

In Action:

I only changed the name of the worksheet and the range to L and L2:L. – Ulquiorra Schiffer 17 mins ago

There are different ways of doing this, but here is one:

Function FixPipes(val As String) As String
    Dim v As Variant
    
    v = Split(val, "||")
    If Len(v(UBound(v))) > 0 Then
      FixPipes = val
    Else
      FixPipes = Mid$(val, 1, Len(val) - 2)
    End If
End Function

Here's another way to do it:

Function FixPipes(val As String) As String
    If Mid$(val, Len(val) - 1, 2) <> "||" Then
      FixPipes = val
    Else
      FixPipes = Mid$(val, 1, Len(val) - 2)
    End If
End Function

Usage:

Sub test()
    Debug.Print FixPipes("Testing||Admin||Moderator||")
End Sub

Or:

Sub LoopIt()
    ' remove this line after verifying the sheet name
    MsgBox ActiveSheet.Name

    Dim lIndex As Long
    Dim lastRow As Long
    lastRow = Range("L" & Rows.Count).End(xlUp).Row
    
    For lIndex = 1 To lastRow
      Range("L" & lIndex) = FixPipes(Range("L" & lIndex))
    Next
End Sub

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/split-function

https://docs.microsoft.com/en-us/office/vba/language/reference/user-interface-help/mid-function

=IF(UNICODE(RIGHT(A2,1))+UNICODE(LEFT(RIGHT(A2,2),1))=248,LEFT(A2,LEN(A2)-2),A2)

A tiny alternative using negative filtering would be:

Function FixPipes(ByVal s As String, Optional delim As String = "||") As String
    Dim tmp: tmp = Filter(Split(s & "$$", delim), "$$", False)
    FixPipes = Replace(Join(tmp, delim), "$$", "")
End Function

Solution using the Replace formula, if you want to do this in VBA you can use the replace function in VBA as well

This is the piece of code I have in the worksheet change event (also module1) and also in the same active worksheet as module2:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const RolesList As String = "Testing"
    Const FirstCellAddress As String = "L2"
    Const Delimiter As String = "||"
    
    Dim rng As Range
    With Range(FirstCellAddress)
        Set rng = Intersect(.Resize(.Worksheet.rows.Count - .Row + 1), Target)
    End With
    If rng Is Nothing Then
        Exit Sub
    End If
    
    Dim Roles() As String: Roles = Split(RolesList, ",")
    
    Dim dRng As Range
    Dim aRng As Range
    Dim cel As Range
    Dim Curr() As String
    Dim cMatch As Variant
    Dim n As Long
    Dim isFound As Boolean
    
    For Each aRng In rng.Areas
        For Each cel In aRng.Cells
            If Not IsError(cel) Then
                Curr = Split(cel.Value, Delimiter)
                For n = 0 To UBound(Curr)
                    cMatch = Application.Match(Curr(n), Roles, 0)
                    If IsError(cMatch) Then
                        isFound = True
                        Exit For
                    Else
                        If StrComp(Curr(n), Roles(cMatch - 1), _
                                vbBinaryCompare) <> 0 Then
                            isFound = True
                            Exit For
                        End If
                    End If
                Next n
                If isFound Then
                    isFound = False
                    If dRng Is Nothing Then
                        Set dRng = cel
                    Else
                        Set dRng = Union(dRng, cel)
                    End If
                End If
            End If
        Next cel
    Next aRng
    
    Application.ScreenUpdating = False
    rng.Interior.Color = xlNone
    If Not dRng Is Nothing Then
        dRng.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True
    
End Sub

I did put your code inside a module2 and also in an active worksheet:

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lrow As Long
    Dim rng As Range
    Dim sAddr As String
    
    Set ws = Sheet1
    
    With ws
        lrow = .Range("L" & .Rows.Count).End(xlUp).Row
        
        Set rng = .Range("L2:L" & lrow)
        sAddr = rng.Address
        
        rng = Evaluate("index(IF(RIGHT(TRIM(" & sAddr & _
                              "),2)=""||"",LEFT(TRIM(" & sAddr & _
                              "),LEN(TRIM(" & sAddr & _
                              "))-2)," & sAddr & _
                              "),)")
    End With
End Sub

For some reason, module2 won't work I suspect module1 to interfere with it indeed but can't find a solution.

My whole code looks like this:

Sub AllInOne()

Application.EnableEvents = True
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Range("F2:F" & Cells(rows.Count, "F").End(xlUp).Row).Copy Destination:=Range("J2")
Range("F2:F" & Cells(rows.Count, "F").End(xlUp).Row).Copy Destination:=Range("K2")

ActiveSheet.Hyperlinks.Delete

For Each rng In Range("F2:F" & Cells(rows.Count, "F").End(xlUp).Row): rng.Value = LCase(rng.Value): Next rng
For Each rng In Range("K2:K" & Cells(rows.Count, "K").End(xlUp).Row): rng.Value = LCase(rng.Value): Next rng
For Each rng In Range("J2:J" & Cells(rows.Count, "J").End(xlUp).Row): rng.Value = LCase(rng.Value): Next rng

Dim cell As Range

lastRow = ActiveSheet.Cells(ActiveSheet.rows.Count, "C").End(xlUp).Row

For Each cell In ActiveSheet.Range("C2:C" & lastRow)
    S = vbNullString
    If cell.Value <> vbNullString Then
        v = Split(cell.Value, " ")
        For Each W In v
            S = S & Left$(W, 1) & "."
        Next W
        cell.Offset(ColumnOffset:=-1).Value = S
    End If
Next cell

Application.Range("B1").Value = "tesing"
Worksheets("Sheet1").Range("B1").Font.Bold = True
        
Columns("D").Replace What:="vander", _
                    Replacement:="van der", _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    MatchCase:=False, _
                    SearchFormat:=False, _
                    ReplaceFormat:=False
Columns("D").Replace What:="vanden", _
                    Replacement:="van den", _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    MatchCase:=False, _
                    SearchFormat:=False, _
                    ReplaceFormat:=False
Columns("B").Replace What:="..", _
                    Replacement:=".", _
                    LookAt:=xlPart, _
                    SearchOrder:=xlByRows, _
                    MatchCase:=False, _
                    SearchFormat:=False, _
                    ReplaceFormat:=False

    Dim r As Range
    For Each r In ActiveSheet.UsedRange
        If Not IsError(r.Value) Then
            v = r.Value
            If v <> vbNullString Then
                If Not r.HasFormula Then
                    r.Value = Trim(v)
                End If
            End If
        End If
    Next r

    Dim i As Long
    Dim DelRange As Range

    On Error GoTo Whoa

    Application.ScreenUpdating = False

    For i = 1 To 50
        If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "Z" & i)) = 0 Then
            If DelRange Is Nothing Then
                Set DelRange = Range("A" & i & ":" & "Z" & i)
            Else
                Set DelRange = Union(DelRange, Range("A" & i & ":" & "Z" & i))
            End If
        End If
    Next i

    If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
    Application.ScreenUpdating = True

    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
    
   Worksheets("Sheet1").Columns("L").Replace _
      What:=" ", _
      Replacement:="", _
      SearchOrder:=xlByColumns, _
      MatchCase:=True

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const RolesList As String = "Testing"
    Const FirstCellAddress As String = "L2"
    Const Delimiter As String = "||"
    
    Dim rng As Range
    With Range(FirstCellAddress)
        Set rng = Intersect(.Resize(.Worksheet.rows.Count - .Row + 1), Target)
    End With
    If rng Is Nothing Then
        Exit Sub
    End If
    
    Dim Roles() As String: Roles = Split(RolesList, ",")
    
    Dim dRng As Range
    Dim aRng As Range
    Dim cel As Range
    Dim Curr() As String
    Dim cMatch As Variant
    Dim n As Long
    Dim isFound As Boolean
    
    For Each aRng In rng.Areas
        For Each cel In aRng.Cells
            If Not IsError(cel) Then
                Curr = Split(cel.Value, Delimiter)
                For n = 0 To UBound(Curr)
                    cMatch = Application.Match(Curr(n), Roles, 0)
                    If IsError(cMatch) Then
                        isFound = True
                        Exit For
                    Else
                        If StrComp(Curr(n), Roles(cMatch - 1), _
                                vbBinaryCompare) <> 0 Then
                            isFound = True
                            Exit For
                        End If
                    End If
                Next n
                If isFound Then
                    isFound = False
                    If dRng Is Nothing Then
                        Set dRng = cel
                    Else
                        Set dRng = Union(dRng, cel)
                    End If
                End If
            End If
        Next cel
    Next aRng
    
    Application.ScreenUpdating = False
    rng.Interior.Color = xlNone
    If Not dRng Is Nothing Then
        dRng.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True
    
End Sub

Remove Trailing String

All Except OP

• This is a follow-up question on How to create data validation based on multiple roles? .
• The answers from Siddharth Rout and braX are valid for someone who might stumble upon this post.
• They would have to be adjusted for OP because this case is 'clouded' by an already existing Worksheet_Change event.

OP (Ulquiorra)

• To not complicate I have integrated a code snippet, which uses a function (similar to the posted solutions), into your existing code and removed Areas since it seems redundant after seeing what you are trying to accomplish.

The Snippet

Application.ScreenUpdating = False
Application.EnableEvents = False
Dim cel As Range
For Each cel In rng.Cells
    cel.Value = removeTrail(cel.Value, Delimiter)
Next cel
Application.EnableEvents = True

The Function

Function removeTrail( _
    ByVal SearchString As String, _
    ByVal RemoveString As String, _
    Optional ByVal doTrim As Boolean = True) _
As String
    If doTrim Then
        removeTrail = Trim(SearchString)
    Else
        removeTrail = SearchString
    End If
    If Right(removeTrail, Len(RemoveString)) = RemoveString Then
        removeTrail = Left(removeTrail, Len(removeTrail) - Len(RemoveString))
    End If
End Function

The Worksheet Change (modified)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Const RolesList As String = "Admin,Clerk,Moderator,User"
    Const FirstCellAddress As String = "L2"
    Const Delimiter As String = "||"
    
    Dim rng As Range
    With Range(FirstCellAddress)
        Set rng = Intersect(.Resize(.Worksheet.Rows.Count - .Row + 1), Target)
    End With
    If rng Is Nothing Then
        Exit Sub
    End If
    
    ' The Snippet
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim cel As Range
    For Each cel In rng.Cells
        cel.Value = removeTrail(cel.Value, Delimiter)
    Next cel
    Application.EnableEvents = True
    
    Dim Roles() As String: Roles = Split(RolesList, ",")
    
    Dim dRng As Range
    Dim aRng As Range
    Dim Curr() As String
    Dim cMatch As Variant
    Dim n As Long
    Dim isFound As Boolean
    
    For Each cel In rng.Cells
        If Not IsError(cel) Then
            Curr = Split(cel.Value, Delimiter)
            For n = 0 To UBound(Curr)
                cMatch = Application.Match(Curr(n), Roles, 0)
                If IsError(cMatch) Then
                    isFound = True
                    Exit For
                Else
                    ' Remove this block if you don't need case-sensitivity.
                    If StrComp(Curr(n), Roles(cMatch - 1), _
                            vbBinaryCompare) <> 0 Then
                        isFound = True
                        Exit For
                    End If
                End If
            Next n
            If isFound Then
                isFound = False
                If dRng Is Nothing Then
                    Set dRng = cel
                Else
                    Set dRng = Union(dRng, cel)
                End If
            End If
        End If
    Next cel
    
    rng.Interior.Color = xlNone
    If Not dRng Is Nothing Then
        dRng.Interior.Color = vbRed
    End If
    Application.ScreenUpdating = True
    
End Sub