Split data across multiple workbook based on unique data of column

[Ramesh Deo]

Hi Members

Please see the attached file, I need vba code. can any one help me out???

 

[Smallman]

Hi Ramesh

I guess your question and file lead to more questions. What column is unique and what do you want the output to look like?

Take care

Smallman

 

[Ramesh Deo]

Hi Excel guru,

thank a lot for your precious response. sir please leave unique word, actually i want to split data based on column A, for example in column A process name "Action","
Advertisement" and so on i want to generate excel file for the same with their data.

 

[Sathish KV]

Hi,

Try the below macro

Sub Split_Data()
 
Range("B3").Select
ActiveCell.CurrentRegion.Select
srcdata = ActiveCell.CurrentRegion.Address
 
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        srcdata).CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Process Name"), "Count of Process Name", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Process Name")
        .Orientation = xlRowField
        .Position = 1
    End With
   
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
   
    ActiveSheet.Name = "Pivot"
    Range("B5").Select
   
    Do While ActiveCell.Value <> ""
    Selection.ShowDetail = True
    ActiveSheet.Name = Range("A2").Value
    Sheets("Pivot").Select
    ActiveCell.Offset(1, 0).Select
    Loop
   
    Application.DisplayAlerts = False
    Sheets("Pivot").Delete
    Application.DisplayAlerts = True
    
   
End Sub

 

[Ramesh Deo]

Hi,

Try the below macro

Sub Split_Data()

Range("B3").Select
ActiveCell.CurrentRegion.Select
srcdata = ActiveCell.CurrentRegion.Address

    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        srcdata).CreatePivotTable TableDestination:="", TableName:= _
        "PivotTable1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Process Name"), "Count of Process Name", xlCount
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Process Name")
        .Orientation = xlRowField
        .Position = 1
    End With
  
    With ActiveSheet.PivotTables("PivotTable1")
        .ColumnGrand = False
        .RowGrand = False
    End With
  
    ActiveSheet.Name = "Pivot"  "Run time error" Application defined-error
    Range("B5").Select
  
    Do While ActiveCell.Value <> ""
    Selection.ShowDetail = True
    ActiveSheet.Name = Range("A2").Value
    Sheets("Pivot").Select
    ActiveCell.Offset(1, 0).Select
    Loop
  
    Application.DisplayAlerts = False
    Sheets("Pivot").Delete
    Application.DisplayAlerts = True
   
  
End Sub

Hi Satish
thank for your answer but found error in marked red line.

 

[Sathish KV]

Hi,

I have tested the macro with the file you have uploaded but could not find any error

Could you upload your file with above macro

 

[Smallman]

Hi Ramesh

Thanks for providing further clarity. I think this should cover it.

Be sure to get the path right. If you get this right it will work. I have tested this on a valid path.

Sub SaveEach()
Const fDir = "C:\Users\HYMC\theSmallman\Test\"
Dim i As Integer
Dim ar As Variant
Dim rng As Range

Set rng = Range("B3", Range("B" & Rows.Count).End(xlUp))
rng.AdvancedFilter 2, , [H1], True
ar = Range("H2", Range("H" & Rows.Count).End(xlUp))

    For i = 1 To UBound(ar)
        rng.AutoFilter 1, ar(i, 1)
        rng.Resize(, 5).Copy
        Workbooks.Add
        [B3].PasteSpecial xlPasteAll
        Range("B:F").EntireColumn.AutoFit
        ActiveWorkbook.SaveAs fDir & ar(i, 1) & ".xlsx"
        ActiveWorkbook.Close False
    Next i
End Sub

File attached to show workings.

Take care

Smallman

 

[Ramesh Deo]

Hi Ramesh

Thanks for providing further clarity. I think this should cover it.

Be sure to get the path right. If you get this right it will work. I have tested this on a valid path.

Sub SaveEach()
Const fDir = "C:\Users\HYMC\theSmallman\Test\"
Dim i As Integer
Dim ar As Variant
Dim rng As Range

Set rng = Range("B3", Range("B" & Rows.Count).End(xlUp))
rng.AdvancedFilter 2, , [H1], True
ar = Range("H2", Range("H" & Rows.Count).End(xlUp))

    For i = 1 To UBound(ar)
        rng.AutoFilter 1, ar(i, 1)
        rng.Resize(, 5).Copy
        Workbooks.Add
        [B3].PasteSpecial xlPasteAll
        Range("B:F").EntireColumn.AutoFit
        ActiveWorkbook.SaveAs fDir & ar(i, 1) & ".xlsx"
        ActiveWorkbook.Close False
    Next i
End Sub

File attached to show workings.

Take care

Smallman

Thanks Smallman ,

thanks a lot for this job.Its working well.now i have a query related to this code, I got an error if Name is with slash like this VAT Debit/Credit Note in Range B. now how can resolve this.

 

[Ramesh Deo]

also if in Range such type of text with sign) example-VAT Debit:Credit Note.

 

[Smallman]

Ramesh

When naming files ideally they should be sequential text or sequential text and numbers

CurrentBudget
FYPlan
ActualRev2014


Never any spaces. That is a good naming convention to follow.

Just happens to solve your problem as well. The above is the naming convention I use and it just works for me.

Take care

Smallman

 

[Ramesh Deo]

Thanks sir, Actually its just a slip of my memory because i know that we can not use some special characters in file naming. but thanks to recap in brief about this.

And if possible please let me know one thing more in brief about Ubound using in for loop.what does exactly mean or its function, in which case we can use it .

 

[Smallman]

Hi Ramesh

The term ubound is short for Upper Bound. This statement

ubound(ar)

traps the upper bounds of the array (ar). So if you have 5 items in the array it will trap the number 5. I have written an article on this on my site. You can learn more here.

The Array

It is a short article and won't take long to get across.

Take care

Smallman