VBA code to filter and separate delimited refs to separate worksheets

[Sindrin]

In a worksheet, I have a list of unique references which are combined with a delimiter in Col.A

These references are with delimiter "|"

Example:

-Row 1 are headings.
-Row 2 have Cell A2 as ["ABC123 | DEF123 | GHI123"]
-Row 3 have Cell A3 as ["ABC123 | XYZ123 | LMN123 | DEF123 | JKL123"]
-Other rows follow the same format with various refs within the cell etc

Query:

I do have the list of unique refs (without the delimiter) on a separate sheet.

Is there a quick way I can split the worksheet [with the combined refs] based on the individual unique refs?

So output would be:

One worksheet will contain all rows containing unique ref "ABC123"
One worksheet will contain all rows containing unique ref "DEF123"
One worksheet will contain all rows containing unique ref "GHI123"
One worksheet will contain all rows containing unique ref "LMN123"
One worksheet will contain all rows containing unique ref "XYZ123"
One worksheet will contain all rows containing unique ref "JKL123"

It would be great if we can keep the headers on the output rows as well

Thank you in advance

 

[Sindrin]

Additionally: it would be great if we can name the output sheet(s) based on unique ref.

 

[aRandomHelper]

Try:

Sub me1158451()
    Dim s As String, i As Long, d, v, t
    Set d = CreateObject("scripting.dictionary")
    Set ws = ActiveSheet
    With ws
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            s = .Cells(i, 1).Value
            s = Replace(Replace(s, "[""", ""), """]", "") 'remove this line if your data does not contain '["' and '"]'
            v = Split(s, "|")
            For Each t In v
                If d.exists(t) Then
                    d(t) = d(t) & "_" & s
                Else
                    d(t) = s
                End If
            Next
        Next
    End With
    For Each t In d.keys
        With Sheets.Add(, Sheets(Sheets.Count))
            .Name = t
            .Cells(1, 1).Value = ws.Cells(1, 1).Value
            v = Split(d(t), "_")
            .Cells(2, 1).Resize(UBound(v) + 1).Value = Application.Transpose(v)
        End With
    Next
End Sub

 

[aRandomHelper]

Add this to trim away spaces (For sheet names):

            s = .Cells(i, 1).Value
            s = Replace(s, " | ", "|")
            s = Replace(Replace(s, "[""", ""), """]", "") 'remove this line if your data does not contain '["' and '"]'

 

[Sindrin]

Hey thanks!

Just tried it and I can see the unique refs (from col. A) are being split to additional sheets e.g. ABC123, EFG123, XYZ123 etc

However those sheets doesn't contain the relevant row data(s) which contain that ref

I just get a transposed value.

Ideal output is for the new sheet to contain the filtered rows based on that unique ref.

So ABC123 worksheet will contain all the rows in main worksheet that contains *ABC123*

Apologies if I wasn't able to clarify at the beginning

 

[aRandomHelper]

However those sheets doesn't contain the relevant row data(s) which contain that ref

I don't get it; it does what you wanted, unless you mean there's more than 1 column of data? Show a sample sheet of it.

 

[Sindrin]

It doesn’t do what I want as I mentioned on my reply, it doesn’t export the filtered rows based on the unique ref.

Say row 2 has column A as abc123, def 123, xyz123 in one cell. This row has transaction details on Col B-Z.

I want a sheet whereby this entire row column a-z will be captured on the individual sheets of abc123, def 123, xyz123 respectively.

so abc 123 will have the entire rows where column contained abc123.

so def123 will have the entire rows where column contained def123.

so xyz123 will have the entire rows where column contained xyz123.

The code you provided just delimits the refs as additional sheets and some random transposed values appear on the spreadsheet

Unfortunately I cannot provide the spreadsheet due to work sensitivity.

thanks for your help anyway !

 

[aRandomHelper]

This row has transaction details on Col B-Z

Yeah you did not mention there's more than 1 column of data.

Try:

Sub me1158451()
    Dim s, i As Long, d, v, t
    Set d = CreateObject("scripting.dictionary")
    Set ws = ActiveSheet
    With ws
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            s = .Cells(i, 1).Value
            s = Replace(s, " | ", "|")
            s = Replace(Replace(s, "[""", ""), """]", "") 'remove this line if your data does not contain '["' and '"]'
            v = Split(s, "|")
            For Each t In v
                If d.exists(t) Then
                    d(t) = d(t) & "_" & i
                Else
                    d(t) = i
                End If
            Next
        Next
    End With
    For Each t In d.keys
        With Sheets.Add(, Sheets(Sheets.Count))
            .Name = t
            .Cells(1, 1).Resize(, 26).Value = ws.Cells(1, 1).Resize(, 26).Value
            v = Split(d(t), "_")
            For Each s In v
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(, 26).Value = ws.Cells(CInt(s), 1).Resize(, 26).Value
            Next
        End With
    Next
End Sub

 

[Sindrin]

Hey it worked on small subset of my data but crashes on my larger data.

The data I’m working on is around 80k rows.

Is there a way to speed up this code ?

Or better yet if you can explain each line of code (the non obvious ones) and I can try to manipulate it to my data and see if some lines I don’t need?

I really appreciate your help on this.

 

[aRandomHelper]

but crashes on my larger data.

Did you get any error? Any line of code got highlighted?

There is probably a way to fix it for larger data set, if there's any error messages that made sense; however, I don't think you can speed it up much -- for such a huge set.