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

Question

I have this problem I can't seem to fix...

In column L I have certain roles, these roles are divided by || (pipes).

The problem: Some people deliver these roles they want to use like this:

Testing||Admin||Moderator||

But this doesn't work for the script we use to import these roles, what I would like to see is that whenever || (pipes) are used and after the pipes are used if there isn't any text following it up it should delete the pipes at the end.

What I tried is the find and replace option, but this also removes the pipes in between the text.

Hope someone can help me!

Problem:

Testing||Admin||Moderator||

Solution:

Testing||Admin||Moderator

If you would clarify the following issues: Does column `L` contain values or formulas? Where are you putting the results when using a formula? Where do you want to put the results when using `VBA` (overwrite?). Which column is your `Worksheet_Change` event code monitoring and which column will it be modifying in case of a change? Will you allow more than one cell to change at the time (copy/paste)? Note that the `Worksheet_Change` event doesn't cover changes happening via formula, but there are other options (`Worksheet_Calculate`). — VBasic2008, Feb 06 '21 at 08:16
I don't use any formula's the Worksheet_Change event is happing in Column L I pasted the code below. — Ulquiorra Schiffer, Feb 06 '21 at 08:39

Siddharth Rout · Answer 1 · 2021-02-06T06:00:44.003

7

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.

Check if the right 2 characters are ||
If "Yes", then take the left characters (LEN - 2)
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

edited Feb 06 '21 at 06:00

answered Feb 06 '21 at 04:54

Siddharth Rout

147,039
17
206
250

Hi, thanks for your comment! Using the formula results in #NAME? for me and using the VBA code results in #VALUE? any advice? – Ulquiorra Schiffer Feb 06 '21 at 05:20
I think you may have made a typo while copying the formulas. Can you paste the exact formula that you are using? – Siddharth Rout Feb 06 '21 at 05:32
Oh nvm, the formula is working indeed, what about the VBA code that still results in #VALUE? – Ulquiorra Schiffer Feb 06 '21 at 05:37
what changes did you make to the vba code? :) – Siddharth Rout Feb 06 '21 at 05:39
I only changed the name of the worksheet and the range to L and L2:L. – Ulquiorra Schiffer Feb 06 '21 at 05:43
Then it should work. I just tested it. May I see your workbook? – Siddharth Rout Feb 06 '21 at 05:44
Yes, what is the best way to share it with you? – Ulquiorra Schiffer Feb 06 '21 at 05:57
Upload it in a free file sharing site. For example wikisend.com or dropbox or onedrive and share the link here. Remeber to remove any confidential info if any. – Siddharth Rout Feb 06 '21 at 05:59
BTW I added a screenshot for VBA to show how it works – Siddharth Rout Feb 06 '21 at 06:00
Wait you did put the code inside a module? – Ulquiorra Schiffer Feb 06 '21 at 06:05
Yes, I did. I put it in a module with the relevant sheet active. You can also put the code in the relevant sheet code area. If you want the code to run from anywhere with any sheet active then you will have to give the full path in the above code. – Siddharth Rout Feb 06 '21 at 06:14
Alright, it seems to work when I use it with a button, I run another code for data validation in a Worksheet_Change I think those two are not working together. Is there A way to call this module without assigning it to a button? – Ulquiorra Schiffer Feb 06 '21 at 06:32
It will work from worksheet change event as well. I am stepping out for couple of hours. In the meantime you may want to see [worksheet change](https://stackoverflow.com/questions/13860894/why-ms-excel-crashes-and-closes-during-worksheet-change-sub-procedure/13861640#13861640) . – Siddharth Rout Feb 06 '21 at 06:34
It's possible whatever code you have in the worksheet change event is causing neither of these to work right. Have you tried removing that just to see? – braX Feb 06 '21 at 06:53

braX · Answer 2 · 2021-02-06T04:45:28.433

5

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://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/split-function

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

edited Feb 06 '21 at 04:45

answered Feb 06 '21 at 03:51

braX

11,506
5
20
33

Would this only work for ("Testing||Admin||Moderator||")? Because I' 'm looking more for an all-around solution, because we do use more roles and these roles can be delivered in random order. I appreciate your answer tho! – Ulquiorra Schiffer Feb 06 '21 at 03:55
The `test` subroutine just shows how to use it. It will work with anything. Also, see the loop code I added. – braX Feb 06 '21 at 03:57
I have put the function inside a module and adjusted the Sub LoopIt() for column L, but I don't see it change anything :O – Ulquiorra Schiffer Feb 06 '21 at 04:16
Did you change `A` to `L` in all 3 places? I updated it for you now that I know you are using column `L` – braX Feb 06 '21 at 04:17
Yes, I did that, doesn't seem to work for me. I'm going to try it in a new excel file. – Ulquiorra Schiffer Feb 06 '21 at 04:31
The only other thing I can think of is that you did not put the code in the `ActiveSheet` – braX Feb 06 '21 at 04:32
So what I did is put the function inside a Module, then put the function in my ActiveSheet with the Sub Loopit(). Still no succes :S – Ulquiorra Schiffer Feb 06 '21 at 04:47
1

Then set some breakpoints and check the variables as you go. – braX Feb 06 '21 at 04:48
Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/228336/discussion-between-ulquiorra-schiffer-and-brax). – Ulquiorra Schiffer Feb 06 '21 at 04:52
1

Are you sure there is no space between the pipes? `||` vs `| |`? Are you sure they are really pipes? Use `F9` to set a breakpoint. Use `F8` to step through the code line by line. You need to learn how to do this anyway if you are going to be using VBA for anything. Knowing how to debug your code is essential. – braX Feb 06 '21 at 05:32

score 1 · Answer 3 · edited Feb 06 '21 at 10:46

1

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

edited Feb 06 '21 at 10:46

Cody Gray - on strike

239,200
50
490
574

answered Feb 06 '21 at 09:39

kuppu

11
2

Thank you for contributing an answer. Would you kindly edit your answer to to include an explanation of your code? That will help future readers better understand what is going on, and especially those members of the community who are new to the language and struggling to understand the concepts. – STA Feb 06 '21 at 10:04

score 1 · Answer 4 · answered Feb 06 '21 at 10:17

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

score 1 · Answer 5 · answered Feb 07 '21 at 16:59

1

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

answered Feb 07 '21 at 16:59

MrT

61
4

Ulquiorra Schiffer · Answer 6 · 2021-02-06T08:44:42.310

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

score 0 · Accepted Answer · answered Feb 06 '21 at 10:31

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

Thanks for your solution I will check in a few hours need to get some rest, I have been fighting this issue for too many hours now T_T, I will get back ASAP. — Ulquiorra Schiffer, Feb 06 '21 at 10:35
Whatever your names are hero's how can I repay you T_T, can I buy you guys a beer for all the help T_T, it finally worked T_T!!! Thank you so much !!! — Ulquiorra Schiffer, Feb 06 '21 at 17:26
I have two more questions how could I use this for multiple columns? I tried ("L2,N2"), but that doesn't seem to work, and also what if I would like to check for another set of data, so not only the roles but let's say e-mail addresses? — Ulquiorra Schiffer, Feb 08 '21 at 06:23

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

7 Answers7

Remove Trailing String