Forum Discussion

Copper Contributor

Nov 24, 2021

Solved

Filter Range Copy Paste the Value and Create new Sheets

I have been trying to find an way to create multiple sheets using Specific Column data. If Col"A" has multiple duplicate entries then filter single value create the new sheet using that value nam...

Nov 24, 2021

You should always post a relevant example instead of one simplified too far.

| is allowed in a sheet name, but the following characters aren't: \ , / , * , ? , : , [ , ].

To get rid of those:

Sub SplitData()
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim col As New Collection
    Dim itm As Variant
    Dim c As Variant
    Application.ScreenUpdating = False
    Set src=Worksheets("Sheet1")
    src.AutoFilterMode = False
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To lastRow
        itm = CStr(src.Range("A" & r).Value)
        col.Add Item:=itm, Key:=itm
    Next r
    On Error GoTo 0
    For Each itm In col
        For Each c In Array("\", "/", "*", "?", ":", "[", "]")
            itm = Replace(itm, c, "_")
        Next c
        Set trg = Nothing
        On Error Resume Next
        Set trg = Worksheets(itm)
        On Error GoTo 0
        If trg Is Nothing Then
            Set trg = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            trg.Name = itm
        Else
            trg.UsedRange.ClearContents
        End If
        src.UsedRange.AutoFilter Field:=1, Criteria1:=itm
        src.UsedRange.Copy Destination:=trg.Range("A1")
    Next itm
    src.AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

LearningExcelVBA

Copper Contributor

Nov 24, 2021

HansVogelaar

I have been receiving an error type mismatch because i have some strings with that signs | and there are 400+ unique values in Column A

HansVogelaar

MVP

Nov 24, 2021

LearningExcelVBA

You should always post a relevant example instead of one simplified too far.

| is allowed in a sheet name, but the following characters aren't: \ , / , * , ? , : , [ , ].

To get rid of those:

Sub SplitData()
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim col As New Collection
    Dim itm As Variant
    Dim c As Variant
    Application.ScreenUpdating = False
    Set src=Worksheets("Sheet1")
    src.AutoFilterMode = False
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To lastRow
        itm = CStr(src.Range("A" & r).Value)
        col.Add Item:=itm, Key:=itm
    Next r
    On Error GoTo 0
    For Each itm In col
        For Each c In Array("\", "/", "*", "?", ":", "[", "]")
            itm = Replace(itm, c, "_")
        Next c
        Set trg = Nothing
        On Error Resume Next
        Set trg = Worksheets(itm)
        On Error GoTo 0
        If trg Is Nothing Then
            Set trg = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            trg.Name = itm
        Else
            trg.UsedRange.ClearContents
        End If
        src.UsedRange.AutoFilter Field:=1, Criteria1:=itm
        src.UsedRange.Copy Destination:=trg.Range("A1")
    Next itm
    src.AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

LearningExcelVBA

Copper Contributor

Nov 24, 2021

I apologize for the mistakes but now there is new problem that is name is exceeding more characters than 31. How to keep the limit to 31 character if it is long.

HansVogelaar

MVP

Nov 24, 2021

LearningExcelVBA

The following will truncate the names to 31 characters. You will have a problem if there are names that differ only beyond the 31st character. For example thisisaridiculouslylongnamenumberone and thisisaridiculouslylongnamenumbertwo. Both will be truncated to thisisaridiculouslylongnamenumb.

Sub SplitData()
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim lastRow As Long
    Dim r As Long
    Dim col As New Collection
    Dim itm As Variant
    Dim c As Variant
    Application.ScreenUpdating = False
    Set src=Worksheets("Sheet1")
    src.AutoFilterMode = False
    lastRow = src.Range("A" & src.Rows.Count).End(xlUp).Row
    On Error Resume Next
    For r = 2 To lastRow
        itm = CStr(src.Range("A" & r).Value)
        col.Add Item:=itm, Key:=itm
    Next r
    On Error GoTo 0
    For Each itm In col
        For Each c In Array("\", "/", "*", "?", ":", "[", "]")
            itm = Replace(itm, c, "_")
        Next c
        itm = Left(itm, 31)
        Set trg = Nothing
        On Error Resume Next
        Set trg = Worksheets(itm)
        On Error GoTo 0
        If trg Is Nothing Then
            Set trg = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            trg.Name = itm
        Else
            trg.UsedRange.ClearContents
        End If
        src.UsedRange.AutoFilter Field:=1, Criteria1:=itm
        src.UsedRange.Copy Destination:=trg.Range("A1")
    Next itm
    src.AutoFilterMode = False
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

LearningExcelVBA
Copper Contributor
Nov 24, 2021
Sir thank you very much