Hi, I wonder whether someone may be able to help me please.

I'm using the code below to create worksheets from the value in a specific cell range.

Sub CreatePortfolioWASheets()
    
    Dim calc As Long
    Dim cll As Range
    Dim i As Long
    Dim LastRow As Long
    Dim Portfoio As String
    Dim rngResults As Range 'filter range
    Dim rngFilter As Range 'filter range
    Dim rngUniques As Range 'Unique Range
    Dim UqPo
    
    Application.ScreenUpdating = False
    Const StartRow As Long = 8
    
    With Worksheets("Unique Records WA")
        If .AutoFilterMode Then .AutoFilterMode = False
        LastRow = .Cells.Find("*", , , , xlByRows, xlPrevious).Row
        Set rngResults = .Range("A1:T" & LastRow)
        Set rngFilter = .Range("F7:F" & LastRow)
        
        For Each cll In rngFilter.Offset(1).Resize(rngFilter.Rows.Count - 1)
            If InStr(UqPo, cll.Value) = 0 Then UqPo = UqPo & "|" & cll.Value
            Next cll
            UqPo = Application.Transpose(Split(Mid(UqPo, 2), "|"))
        End With
        
        
        For i = LBound(UqPo) To UBound(UqPo)
            rngFilter.AutoFilter Field:=1, Criteria1:=UqPo(i, 1)
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            With ActiveSheet
                .Name = UqPo(i, 1)
                rngResults.SpecialCells(xlCellTypeVisible).Copy
                With .Range("A1")
                    .PasteSpecial
                    .Select
                End With
                .Columns.AutoFit
                LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
                If LastRow >= StartRow Then
                    With .Range("H8:S" & LastRow)
                        On Error Resume Next
                        For Each cll In .SpecialCells(xlCellTypeConstants, 1)
                            cll.Value = cll.Value
                            .NumberFormat = "0%"
                            With .Font
                                Bold = True
                            End With
                            Next cll
                        End With
                        On Error GoTo 0
                    End If
                    rngFilter.Parent.AutoFilterMode = False
                End With
                Next i
                
                Application.ScreenUpdating = False
                Call SubtotalsandDelete
            End Sub
The issue I have is that I know in Excel 2003 there is a sheet name length of 31 charcters, so when the code finds a cell value greater than this, it throws an error.

This is the line which creates the sheet name .Name = UqPo(i, 1). Could someone perhaps tell me please is there a way whereby when the script reaches a cell with a value greater than 31 characters, when it creates the sheet, it automatically shortens the sheet name to 30 charcaters and then a full stop to reach the 31 character maximum.

Many thanks and kind regards

Chris