Trim rows in multiple sheets

[Paul_Hossler]

Try this

Option Explicit


Sub test()
    Dim ws As Worksheet
    Dim r As Range, c As Range
    Dim n As Long
    
    Application.ScreenUpdating = False
    
    For Each ws In ActiveWorkbook.Worksheets
        Set r = Nothing
        On Error Resume Next
        Set r = ws.UsedRange.SpecialCells(xlCellTypeConstants, xlTextValues)
        On Error GoTo 0
        
        If Not r Is Nothing Then
            For Each c In r.Cells
                n = InStr(c.Value, ", ""roles""")
                If n > 0 Then c.Value = Left(c.Value, n - 1) & "}"
            Next
        End If
    Next


    Application.ScreenUpdating = False


    MsgBox "Done"
End Sub