Hello,
Based on the old thread:
The code it's working fine but I have problems when the sheet names exceeds 31 characters
How can I modify the code to truncate the name below 31 chars even it's longer ?
I got the following message: You typed an invalid name for sheet (pic attached)
Code:
Code
- Option Explicit
- Sub test()
- Dim e
- Application.ScreenUpdating = False
- With Sheets("cardio").Range("a6").CurrentRegion
- For Each e In Filter(.Parent.Evaluate("transpose(if(countif(offset(" & _
- .Columns(3).Offset(1).Address & ",0,0,row(1:" & .Rows.Count & "))," & _
- .Columns(3).Offset(1).Address & ")=1," & .Columns(3).Offset(1).Address & _
- ",char(2)))"), Chr(2), False)
- If Not IsSheetExists(e) Then
- Sheets.Add(after:=Sheets(Sheets.Count)).Name = e
- End If
- .Parent.Cells.Copy Sheets(e).Cells(1)
- With Sheets(e)
- With .Range("a6").CurrentRegion
- .AutoFilter 3, "<>" & e
- .Offset(1).EntireRow.Delete
- .AutoFilter
- End With
- End With
- Next
- End With
- Application.ScreenUpdating = True
- End Sub
- Function IsSheetExists(ByVal txt As String) As Boolean
- On Error Resume Next
- IsSheetExists = Len(Sheets(txt).Name)
- On Error Goto 0
- End Function
Thanks
Cristi
