Row based excel file split

[vijay20cbe]

Hi,

I'm new to Macro and VBA. I'm looking a Macro or VBA regarding file split based on the row(s). The expected output should be

1. First Row or Row Header is a constant or common for each file.
2. Based on Cloumn A or B or C or anyother Column value, the file should be split along with the respective parellel data. Ex: If column A has
- Adam
- Brain
- Charlie
the output file name will be Adam then Brain then Charlie seperately with the data.
3. If my file has validation that also should reflect with the file which is split.
4. Macro or VBA should ask to the user to locate the path where the user wants to create the file. If the path is existed then the split file should create the same location.

Challenges
1. Everyday the Column A or B or C or etc will vary.
2. Everyday the validation will change..

Help me to Paste the Macro or VBA in my excel book with step by step procedure.

Note: Please excuse, I can't share the data though it is very sensitive. Hope the requirement is understandable. For further clarification do revert.

Thanks in advance.

Regards,
Vijay

[JBeaucaire]

'SHEET1 TO MANY WORKBOOKS
Here's a macro for parsing rows of data from one sheet to many workbooks named for the same values.

Sheet1 to Many Workbooks

My macro names the workbooks for values in the column PLUS today's date, you can take a stab at removing the date part...or leave it in, it's a good technique.

Option Explicit

Sub ParseItems()
'Jerry Beaucaire  (4/22/2010)
'Based on selected column, data is filtered to individual workbooks
'workbooks are named for the value plus today's date
Dim LR As Long, Itm As Long, MyCount As Long, vCol As Long
Dim ws As Worksheet, MyArr As Variant, vTitles As String, SvPath As String

'Column to evaluate from, column A = 1, B = 2, etc. (edit as needed)
   vCol = Application.InputBox("What column to split data by? " & vbLf _
        & vbLf & "(A=1, B=2, C=3, etc)", "Which column?", 1, Type:=1)
   If vCol = 0 Then Exit Sub
 
'Sheet with data in it     (edit as needed)
   Set ws = Sheets("Original Data")

'Path to save files into, remember the final \     (edit as needed)
    SvPath = "C:\2010\"

'Range where titles are across top of data, as string, data MUST
'have titles in this row, edit to suit your titles locale
    vTitles = "A1:Z1"
   
'Spot bottom row of data
   LR = ws.Cells(ws.Rows.Count, vCol).End(xlUp).Row

Application.ScreenUpdating = False

'Get a temporary list of unique values from column A
    ws.Columns(vCol).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("EE1"), Unique:=True

'Sort the temporary list
    ws.Columns("EE:EE").Sort Key1:=ws.Range("EE2"), Order1:=xlAscending, Header:=xlYes, _
       OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

'Put list into an array for looping (values cannot be the result of formulas, must be constants)
    MyArr = Application.WorksheetFunction.Transpose(ws.Range("EE2:EE" & Rows.Count).SpecialCells(xlCellTypeConstants))

'clear temporary worksheet list
    ws.Range("EE:EE").Clear

'Turn on the autofilter, one column only is all that is needed
    ws.Range(vTitles).AutoFilter

'Loop through list one value at a time
    For Itm = 1 To UBound(MyArr)
        ws.Range(vTitles).AutoFilter Field:=vCol, Criteria1:=MyArr(Itm)
        
        ws.Range("A1:A" & LR).EntireRow.Copy
        Workbooks.Add
        Range("A1").PasteSpecial xlPasteAll
        Cells.Columns.AutoFit
        MyCount = MyCount + Range("A" & Rows.Count).End(xlUp).Row - 1
        
        ActiveWorkbook.SaveAs SvPath & MyArr(Itm) & Format(Date, " MM-DD-YY"), xlNormal
        ActiveWorkbook.Close False
        
        ws.Range(vTitles).AutoFilter Field:=vCol
    Next Itm

'Cleanup
    ws.AutoFilterMode = False
    MsgBox "Rows with data: " & (LR - 1) & vbLf & "Rows copied to other sheets: " & MyCount & vbLf & "Hope they match!!"
    Application.ScreenUpdating = True
End Sub