How to split data into multiple worksheets based on column in Excel?

[Jordi_ws]

Hi everybody,

This is my first post here in this forum, and first of all I would like to congratulate all the members, users, experts and so that make possible this site. Since I discovered this forum I have learnt some important tips to improve my very amateur Excel skills and had been able to apply them on my job.

Since now I've only been reading some threads and now I decided to post my first question, I've tried a deep search to try not to repeat already answered questions but with no success with my specific case.

As the title says this is a subject already discussed but I came across with a (surely) small issue when applying to my files.

I have applied this code to other works with success, but I'm not able to adapt to a new project I'm working in:

<code class="vb keyword">Sub</code> <code class="vb plain">parse_data()</code>

<code class="vb keyword">Dim</code> <code class="vb plain">lr </code><code class="vb keyword">As</code> <code class="vb keyword">Long</code>
<code class="vb keyword">Dim</code> <code class="vb plain">ws </code><code class="vb keyword">As</code> <code class="vb plain">Worksheet</code>
<code class="vb keyword">Dim</code> <code class="vb plain">vcol, i </code><code class="vb keyword">As</code> <code class="vb keyword">Integer</code>
<code class="vb keyword">Dim</code> <code class="vb plain">icol </code><code class="vb keyword">As</code> <code class="vb keyword">Long</code>
<code class="vb keyword">Dim</code> <code class="vb plain">myarr </code><code class="vb keyword">As</code> <code class="vb keyword">Variant</code>
<code class="vb keyword">Dim</code> <code class="vb plain">title </code><code class="vb keyword">As</code> <code class="vb keyword">String</code>
<code class="vb keyword">Dim</code> <code class="vb plain">titlerow </code><code class="vb keyword">As</code> <code class="vb keyword">Integer</code>
<code class="vb plain">vcol = 1 </code>
<code class="vb keyword">Set</code> <code class="vb plain">ws = Sheets(</code><code class="vb string">"Sheet1"</code><code class="vb plain">) </code>
<code class="vb plain">lr = ws.Cells(ws.Rows.Count, vcol).</code><code class="vb keyword">End</code><code class="vb plain">(xlUp).Row</code>
<code class="vb plain">title = </code><code class="vb string">"A1:C1"</code>
<code class="vb plain">titlerow = ws.Range(title).Cells(1).Row</code>
<code class="vb plain">icol = ws.Columns.Count</code>
<code class="vb plain">ws.Cells(1, icol) = </code><code class="vb string">"Unique"</code>
<code class="vb keyword">For</code> <code class="vb plain">i = 2 </code><code class="vb keyword">To</code> <code class="vb plain">lr</code>
<code class="vb keyword">On</code> <code class="vb keyword">Error</code> <code class="vb keyword">Resume</code> <code class="vb keyword">Next</code>
<code class="vb keyword">If</code> <code class="vb plain">ws.Cells(i, vcol) <> </code><code class="vb string">""</code> <code class="vb keyword">And</code> <code class="vb plain">Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 </code><code class="vb keyword">Then</code>
<code class="vb plain">ws.Cells(ws.Rows.Count, icol).</code><code class="vb keyword">End</code><code class="vb plain">(xlUp).Offset(1) = ws.Cells(i, vcol)</code>
<code class="vb keyword">End</code> <code class="vb keyword">If</code>
<code class="vb keyword">Next</code>
<code class="vb plain">myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))</code>
<code class="vb plain">ws.Columns(icol).Clear</code>
<code class="vb keyword">For</code> <code class="vb plain">i = 2 </code><code class="vb keyword">To</code> <code class="vb plain">UBound(myarr)</code>
<code class="vb plain">ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & </code><code class="vb string">""</code>
<code class="vb keyword">If</code> <code class="vb keyword">Not</code> <code class="vb plain">Evaluate(</code><code class="vb string">"=ISREF('"</code> <code class="vb plain">& myarr(i) & </code><code class="vb string">"'!A1)"</code><code class="vb plain">) </code><code class="vb keyword">Then</code>
<code class="vb plain">Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & </code><code class="vb string">""</code>
<code class="vb keyword">Else</code>
<code class="vb plain">Sheets(myarr(i) & </code><code class="vb string">""</code><code class="vb plain">).Move after:=Worksheets(Worksheets.Count)</code>
<code class="vb keyword">End</code> <code class="vb keyword">If</code>
<code class="vb plain">ws.Range(</code><code class="vb string">"A"</code> <code class="vb plain">& titlerow & </code><code class="vb string">":A"</code> <code class="vb plain">& lr).EntireRow.Copy Sheets(myarr(i) & </code><code class="vb string">""</code><code class="vb plain">).Range(</code><code class="vb string">"A1"</code><code class="vb plain">)</code>
<code class="vb plain">Sheets(myarr(i) & </code><code class="vb string">""</code><code class="vb plain">).Columns.AutoFit</code>
<code class="vb keyword">Next</code>
<code class="vb plain">ws.AutoFilterMode = </code><code class="vb keyword">False</code>
<code class="vb plain">ws.Activate</code>
<code class="vb keyword">End</code> <code class="vb keyword">Sub</code>

Note: In the above code:

• vcol =1, the number 1 is the column number that you want to split the data based on.
• Set ws = Sheets("Sheet1"), Sheet1 is the sheet name that you want to apply this code.
• title = "A1:C1", A1:C1 is the range of the title.

I've found that code here, and it rings me a bell that this one or a similar one was already discussed here.

When I'm using one single starting sheet "Sheet(1)", there is no problem when running this code, the information gets split in several tabs according the data of one given column (in the case of the example, the 1st column "vcol=1").

In my current project the code starts copying the first sheet, so I get two sheets, the original one and the processed one, and when trying to adapt this code to this new frame, the problem I get is that new tabs are created with the name of the given column, but all data of the reference tab is copied (and not split as required).

In this project the values I changed to suit my needs are the following:

vcol=10 (as the reference data is in 10th column, J one).
Set ws=Sheet(2), as the information to split is now in the second sheet.
title = "A1:K1", as the titles are in this range

The names of the tabs (from column J) are under 30 words (as I've found in another thread regarding another issue).

So this is my question: how could I fix this to suit my project? What other parts of the code should I check/understand to properly set it? Do you need more data regarding this? (i.e. Excel version or so).


I appreciate your help in this issue, I give you thanks in advance and I hope to keep learning about the capacities of Excel. Many thanks.