Split worksheet into multiple tabs

[pkearnes]

I have 1mm records that I need to split into multiple tabs in the same spreadsheet based on the value of column A. I need each tab titled by the value of column A. Any help is greatly appreciated.

[stanleydgrom]

pkearnes,

Welcome to the VBA Express forum.

What version of Excel are you using?

Can we have a sample workbook with the raw data on one worksheet (with it's actual worksheet name), and, on another worksheet a sample of what the results should look like?

To attach your workbook, scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

[pkearnes]

I am using version 7.
Attached is a zip file containing 2 xlsx files:
Sample1.xlsx is a sample of 150 records. This is a sample of the data file as it comes in.
Sample2.xlsx is the output I am looking for.
Note: because of proprietary data within the files, I have limited the data elements in the example to those I am comfortable do not violate my client's confidentiality.

[stanleydgrom]

pkearnes,

I have had a bad experience with zipped files.

Can you attach each workbook separately?

Or, attach one workbook with two worksheets.

[pkearnes]

OK, if you can split them out...that's good. Tab1=Sample1
The remaining tabs are Sample2 - All the data matching Sample1 and then the additional tabs to be created based on unique values in column A.
Thanks for your assistance!

[stanleydgrom]

pkearnes,

Thanks for the latest workbook.

The two raw data worksheets Sample1 and Sample2, or whatever name they really go by, must be the active worksheet before you run the macro.

If all the raw data worksheets begin with Sample, then I will adjust the macro accordingly.

Make sure you copy all the macro code and the function.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


[VBA]

Option Explicit
Sub DistributeRowsPlus()
' stanleydgrom, 07/17/2013
' http://www.vbaexpress.com/forum/showthread.php?t=46858
Dim w1 As Worksheet, wT As Worksheet, wN As Worksheet
Dim r As Long, lr As Long, lrt As Long, nr As Long, lc As Long, h As String, s
Application.ScreenUpdating = False
Set w1 = ActiveSheet
lr = w1.Range("A" & Rows.Count).End(xlUp).Row
If Not Evaluate("ISREF(Temp!A1)") Then Worksheets.Add(After:=w1).Name = "Temp"
Set wT = Worksheets("Temp")
wT.UsedRange.Clear
w1.Range("A1:A" & lr).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wT.Range("A1"), Unique:=True
lrt = wT.Range("A" & Rows.Count).End(xlUp).Row
For r = 2 To lrt
h = wT.Range("A2")
If Not WorksheetExists(h) Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = h
Set wN = Worksheets(h)
w1.Rows("1:" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wT.Range("A1:A2"), _
CopyToRange:=wN.Range("A1"), Unique:=False
wN.Rows(1).Value = w1.Rows(1).Value
wN.UsedRange.Columns.AutoFit
wT.Rows(2).Delete
Else
Set wN = Worksheets(h)
nr = wN.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
w1.Rows("1:" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=wT.Range("A1:A2"), _
CopyToRange:=wN.Range("A" & nr), Unique:=False
wN.Rows(1).Value = w1.Rows(1).Value
wN.Rows(nr).Delete
wN.UsedRange.Columns.AutoFit
wT.Rows(2).Delete
End If
Next r
Application.DisplayAlerts = False
wT.Delete
Application.DisplayAlerts = True
w1.Activate
Application.ScreenUpdating = True
End Sub

Function WorksheetExists(WSName As String) As Boolean
On Error Resume Next
WorksheetExists = Worksheets(WSName).Name = WSName
On Error GoTo 0
End Function

[/VBA]


Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the DistributeRowsPlus macro.

[stanleydgrom]

pkearnes,

When you run the macro on each of the raw data worksheets Sample1 and Sample2, there may be duplicate rows in the three new worksheets.

If you do not want the duplicates I write some code to delete them.

[pkearnes]

Works great; thank you!

[stanleydgrom]

pkearnes,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.

[jwilmot]

I spent most of the day trying out stuff on the KB but this was exactly what I needed. Thank you so much. This step was the most time consuming part of my project, the rest is easy to record or even do manually (perish the thought). This is going on my code library for sure.

[stanleydgrom]

jwilmot,

Welcome to the VBA Express forum.

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.