Split an Excel File into Multiple Files by Multiple Criteria [Using Macro/VBA]

K

kelz_dunks4life

New Member
Joined
Sep 13, 2014
Messages
5
Good Morning All,

I was wondering if there's a way to take an Excel file that can be split into multiple files by multiple criteria. I tried searching the forum, but couldn't find anything [or maybe I missed it].

Please see the example below.

The file needs to be split into multiple workbooks by the 'PT_Name' that ONLY contains information from 'UC_BC' that is either 171, 172, 173, or174.

For instance:

DAILY CENSUS MASTER.XLS

DT OF SVCSTNRM/BEDUB_CDCUR ACADM DTLOSPT NAMENXT REV|DATEMRNACCT#DOBSEXAGEADM DXSVCTYPEATTEND MDTOTAL CHGSFCINS1POLICY#1APPROVAL#1INS2POLICY#2APPROVAL#2INS3POLICY#3APPROVAL#3TOT|DAYS
9/12/20143EE326-A123K9/8/20144COUNT, DOES NOT9/9/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$40,244.20HSXYZ1234567890
9/12/20143EE335-A123K9/8/20144COUNT, DOES NOT9/15/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$42,512.401XYZ1234567890
9/12/20143EE338-A123K9/10/20142COUNT, DOES NOT9/12/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$10,687.25AEXYZ1234567890
9/12/20143EE344-A171K7/11/201463ONE, PLAYER7/15/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$784,728.79EXYZ1234567890
9/12/20143EE340-A171K8/6/201437ONE, PLAYER9/13/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$463,681.6512XYZ1234567890
9/12/20143EE336-A172J9/11/20141TWO,PLAYER999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$2,964.25UHXYZ123456789
9/12/20143EE343-A173K9/8/20144THREE,PLAYER9/9/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$28,745.45KAXYZ1234567890
9/12/20143EE325-A173K9/7/20145THREE,PLAYER9/12/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$37,135.1011XYZ1234567890
9/12/20143EE342-A174K8/15/201428FOUR, PLAYER8/19/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$279,051.21HSXYZ1234567890

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>


And split certain contents into multiple files saved by the PT Name:


  • PT Name that only contains UB_CD as 171, 172, 173, and 174

ONE,PLAYER.XLS

DT OF SVCSTNRM/BEDUB_CDCUR ACADM DTLOSPT NAMENXT REV|DATEMRNACCT#DOBSEXAGEADM DXSVCTYPEATTEND MDTOTAL CHGSFCINS1POLICY#1APPROVAL#1INS2POLICY#2APPROVAL#2INS3POLICY#3APPROVAL#3TOT|DAYS
9/12/20143EE344-A171K7/11/201463ONE, PLAYER7/15/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$784,728.79EXYZ1234567890
9/12/20143EE340-A171K8/6/201437ONE, PLAYER9/13/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$463,681.6512XYZ1234567890

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

TWO,PLAYER.XLS

DT OF SVCSTNRM/BEDUB_CDCUR ACADM DTLOSPT NAMENXT REV|DATEMRNACCT#DOBSEXAGEADM DXSVCTYPEATTEND MDTOTAL CHGSFCINS1POLICY#1APPROVAL#1INS2POLICY#2APPROVAL#2INS3POLICY#3APPROVAL#3TOT|DAYS
9/12/20143EE336-A172J9/11/20141TWO,PLAYER999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$2,964.25UHXYZ123456789

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>

THREE,PLAYER.XLS

DT OF SVCSTNRM/BEDUB_CDCUR ACADM DTLOSPT NAMENXT REV|DATEMRNACCT#DOBSEXAGEADM DXSVCTYPEATTEND MDTOTAL CHGSFCINS1POLICY#1APPROVAL#1INS2POLICY#2APPROVAL#2INS3POLICY#3APPROVAL#3TOT|DAYS
9/12/20143EE343-A173K9/8/20144THREE,PLAYER9/9/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$28,745.45KAXYZ1234567890
9/12/20143EE325-A173K9/7/20145THREE,PLAYER9/12/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$37,135.1011XYZ1234567890

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>
FOUR,PLAYER.XLS

DT OF SVCSTNRM/BEDUB_CDCUR ACADM DTLOSPT NAMENXT REV|DATEMRNACCT#DOBSEXAGEADM DXSVCTYPEATTEND MDTOTAL CHGSFCINS1POLICY#1APPROVAL#1INS2POLICY#2APPROVAL#2INS3POLICY#3APPROVAL#3TOT|DAYS
9/12/20143EE342-A174K8/15/201428FOUR, PLAYER8/19/2014999999999999999999999999999999999999999999NICIPKELZ_DUNKS4LIFE$279,051.21HSXYZ1234567890

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col span="5"><col><col><col><col><col><col><col><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>


Is this something possible? I've suggested using a Pivot Table, but I'd rather find out from any of you if this is something that cannot be done. I hope I was clear and I appreciate your help.

Kels
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying
Sort by date Sort by votes
Give this a try, it worked OK in xl2007 and should work on earlier versions. It is assumed the code will be run from the master workbook. Copy the code below to code module 1 in the master file.
Code: 
Sub multFile()
Dim wb1 As Workbook, wbk As Workbook, sh As Worksheet, lr As Long
Set wb1 = ThisWorkbook
Set sh = wb1.Sheets(1)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
    For i = 171 To 174
        If Application.CountIf(sh.Range("D2:D" & lr), i) > 0 Then
            Set wb = Workbooks.Add
            sh.UsedRange.AutoFilter 4, i
            sh.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy wb.Sheets(1).Range("A2")
            sh.Rows(1).Copy wb.Sheets(1).Range("A1")
            sh.UsedRange.AutoFilter
            fPath = ThisWorkbook.Path
            If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
            wb.SaveAs fPath & "UB_CD" & i
            wb.Close False
        End If
    Next
End Sub
 
Upvote 0
Hi JLGWhiz,

Excellent! It worked!

Just one question. It is possible to have the file saved under each PT Name? I appreciate your help!
 
Upvote 0
kelz_dunks4life said:
Hi JLGWhiz,

Excellent! It worked!

Just one question. It is possible to have the file saved under each PT Name? I appreciate your help!
Click to expand...

Try this modified version
Code: 
Sub multFile2()
Dim wb1 As Workbook, wb As Workbook, sh As Worksheet, lr As Long
Set wb1 = ThisWorkbook
Set sh = wb1.Sheets(1)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
    For i = 171 To 174
        If Application.CountIf(sh.Range("D2:D" & lr), i) > 0 Then
            Set wb = Workbooks.Add
            sh.UsedRange.AutoFilter 4, i
            sh.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy wb.Sheets(1).Range("A2")
            sh.Rows(1).Copy wb.Sheets(1).Range("A1")
            sh.UsedRange.AutoFilter
            fPath = ThisWorkbook.Path
            If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
            wb.SaveAs fPath & wb.Sheets(1).Range("H2").Value & i
            wb.Close False
        End If
    Next
End Sub
 
Upvote 0
Thanks, again. It worked. I just realized that when I tested it on the real file [it contains confidential information], it'll only create 4 files, each file containing all of the '171', '172', '173', and '174'. Sorry to be a pest, but is it possible to get the data by PT_Name, but keep the criteria in tact? I needed to have the each PT Name have it's own file that contains either the four UB_CD. For instance, if there were 50 unique PT_Name that have either 171, 172, 173, or 174, there'll be 50 files. I really appreciate the help.
 
Upvote 0
kelz_dunks4life said:
Thanks, again. It worked. I just realized that when I tested it on the real file [it contains confidential information], it'll only create 4 files, each file containing all of the '171', '172', '173', and '174'. Sorry to be a pest, but is it possible to get the data by PT_Name, but keep the criteria in tact? I needed to have the each PT Name have it's own file that contains either the four UB_CD. For instance, if there were 50 unique PT_Name that have either 171, 172, 173, or 174, there'll be 50 files. I really appreciate the help.
Click to expand...


Sorry for the double post, but if it's possible to do the same with just a Pivot Table filtering only the four UB_CD's and it's much easier, that'd be appreciated as well.
 
Upvote 0
kelz_dunks4life said:
Sorry for the double post, but if it's possible to do the same with just a Pivot Table filtering only the four UB_CD's and it's much easier, that'd be appreciated as well.
Click to expand...

I think this will do it.
Code: 
Sub multFile3()
Dim wb1 As Workbook, wb As Workbook, sh As Worksheet, lr As Long, tSh As Worksheet, c As Range
Set wb1 = ThisWorkbook
Set sh = wb1.Sheets(1)
lr = sh.Cells(Rows.Count, 4).End(xlUp).Row
Sheets.Add After:=ThisWorkbook.Sheets(Sheets.Count)
Set tSh = ActiveSheet
    For i = 171 To 174
        If Application.CountIf(sh.Range("D2:D" & lr), i) > 0 Then
            sh.UsedRange.AutoFilter 4, i
            sh.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy tSh.Cells(Rows.Count, 1).End(xlUp)(2)
            sh.Rows(1).Copy tSh.Range("A1")
            sh.UsedRange.AutoFilter
        End If
    Next
lc = tSh.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
tSh.Range("H2:H" & lr).AdvancedFilter xlFilterCopy, , tSh.Cells(1, lc + 1), True
    With tSh
        For Each c In .Range(.Cells(2, lc + 1), .Cells(Rows.Count, lc + 1).End(xlUp))
            .UsedRange.AutoFilter 8, c.Value
            Set wb = Workbooks.Add
            .Range("H2:H" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy wb.Sheets(1).Range("A2")
            tSh.Rows(1).Copy wb.Sheets(1).Range("A1")
            fPath = ThisWorkbook.Path
            If Right(fPath, 1) <> "\" Then fPath = fPath & "\"
            wb.SaveAs fPath & c.Value
            wb.Close False
        Next
    End With
Application.DisplayAlerts = False
sh.Columns(lc + 1).Delete
tSh.Delete
Application.DisplayAlerts = True
End Sub
 
Upvote 0
Delete this line of code.
Code: 
sh.Columns(lc + 1).Delete
The temp column was used in the temporary sheet which is deleted entirely, so the line is not needed.
 
Upvote 0
JLGWhiz said:
Delete this line of code.
Code: 
sh.Columns(lc + 1).Delete
The temp column was used in the temporary sheet which is deleted entirely, so the line is not needed.
Click to expand...

Thanks as always, JLGWhiz.

I'm able to save, but every time I add the new data, it'll give me the alert that the 'X' file already exists and if I want to save. I do want it to save automatically and I've tried the VBA Codes on google to disable it but it won't work. Do you have any suggestions? Maybe I'm missing something. By the way, I've been also getting assistance from here as well.
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Question
Run Macro using batch file
Replies
0
Views
1K
Fatman003
F
K
  • Question
Split one table into multiple sheets based on criteria
2
Replies
14
Views
2K
Kyosti
K
V
  • Question
VBA coding to autofilter the data ( with some criteria), when the data starts from row 3
Replies
0
Views
388
Vishnu Kariappa
V
C
  • Question
Macro to move row data to columns
2
Replies
11
Views
1K
hiker95
H
B
  • Question
Split master excel into multiple files based on date
Replies
0
Views
695
bipul
B

Forum statistics

Threads
1,214,431
Messages
6,119,458
Members
448,899
Latest member
maplemeadows

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top