Error when splitting data by column

[D-Angle]

I am trying to split the data in my file into multiple sheets based on a single column. I can find plenty of solutions to do it with VBA but for my data in paricular it throws up a problem, as some of the sheets process fine, but others are blank.

Every solution I can find renames the new sheet with the unique value from the column that generates it, but some are just blank and the sheet has a default title (Sheet5, Sheet6 etc.) Some of the values in the column are quite long which I think causes the problem, as sheet titles can only be 31 characters long. Is there a way of doing it that doesn't rename the sheets so it can just split the data?

 

[Joe4]

It might be helpful if you can post a sampling of your data, along with the VBA code you are trying to use.
You can post screen images using the tool mentioned here: XL2BB - Excel Range to BBCode

 

[D-Angle]

I can't post the data in its entirety as some of it is confidential, but the column I am using to split the data contains the following:

St Helens and Knowsley - ST1
Chester - ST1
Bolton - ST1
Bolton - ST1
Bolton - ST1
Bolton - ST1
Bolton - ST1
East Lancashire - ST1
East Lancashire - ST1
Greater Manchester Deprivation - ST1
Greater Manchester Deprivation - ST1
Macclesfield - ST1
Macclesfield - ST1
Macclesfield - ST1
Macclesfield - ST1
Macclesfield - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Pennine Northwest (N. Manchester, Bury, Oldham & Rochdale) - ST1
Preston, Chorley & District - ST1
Preston, Chorley & District - ST1
Preston, Chorley & District - ST1
Salford & Trafford - ST1
Salford & Trafford - ST1
Salford & Trafford - ST1
Sefton / North Liverpool - ST1
Sefton / North Liverpool - ST1
Sefton / North Liverpool - ST1
Sefton / North Liverpool - ST1
Sefton / North Liverpool - ST1
Sefton / North Liverpool - ST1
South & Central Manchester - ST1
South & Central Manchester - ST1
South Liverpool & Birkenhead - ST1
South Liverpool & Birkenhead - ST1
South Liverpool & Birkenhead - ST1
South Liverpool & Birkenhead - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
St Helens and Knowsley - ST1
Stockport - ST1
Stockport - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Warrington and Halton - ST1
Wigan - ST1
Wigan - ST1
Wigan - ST1
Wirral - ST1
Wirral - ST1
Wirral - ST1

 

[D-Angle]

The VBA code I am using is from here and is as follows:

Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer

    'This macro splits data into multiple worksheets based on the variables on a column found in Excel.
    'An InputBox asks you which columns you'd like to filter by, and it just creates these worksheets.

    Application.ScreenUpdating = False
    vcol = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Default:="3", Type:=1)
    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear

    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        'Sheets(myarr(i) & "").Columns.AutoFit
    Next

    ws.AutoFilterMode = False
    ws.Activate
    Application.ScreenUpdating = True
End Sub

It works fine on rows where the data isn't that long, but doesn't work on longer ones. I think if it didn't rename the tabs that it creates, it might work?

 

[Joe4]

If the issue is that some of the values' lengths are over 32 characters, maybe we can try capping the sheet names to the first 32 characters of each string, i.e.

Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    Dim shtName As String

    'This macro splits data into multiple worksheets based on the variables on a column found in Excel.
    'An InputBox asks you which columns you'd like to filter by, and it just creates these worksheets.

    Application.ScreenUpdating = False
    vcol = Application.InputBox(prompt:="Which column would you like to filter by?", title:="Filter column", Default:="3", Type:=1)
    Set ws = ActiveSheet
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next

    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear

    For i = 2 To UBound(myarr)
        shtName = Left(myarr(i), 32)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=shtName & ""
        If Not Evaluate("=ISREF('" & shtName & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = shtName & ""
        Else
            Sheets(shtName & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(shtName & "").Range("A1")
        'Sheets(shtName & "").Columns.AutoFit
    Next

    ws.AutoFilterMode = False
    ws.Activate
    Application.ScreenUpdating = True
End Sub

 

[D-Angle]

Thanks for that, but it is still throwing up the same issue, the new tabs generated from a value under 32 characters are fine, but the ones over 32 characters are blank. Is there a way I could just name each sheet with an escalating number (1, 2 etc.) instead?

 

[Joe4]

Thanks for that, but it is still throwing up the same issue, the new tabs generated from a value under 32 characters are fine, but the ones over 32 characters are blank. Is there a way I could just name each sheet with an escalating number (1, 2 etc.) instead?

Sure. Just try using the "i" variable counter that you are currently using for all the sheet name arguments.

 

[D-Angle]

Hmm, I couldn't get that to work in the end. I have solved it by adding a module that assigns an ID number to each unique value in a new column, and then I use the original module to split it using the ID number column. I have a button that runs the ID module, then the data splitting module. It's not very elegant but it works very well.