Results 1 to 6 of 6

Thread: split data into multiple workbooks with 3 conditions.

  1. #1
    Junior Member
    Join Date
    Apr 2012
    Posts
    4
    Rep Power
    0

    split data into multiple workbooks with 3 conditions.

    HI admin,

    I require a macro file or coding to split data into multiple workbooks but with 3 conditions.

    Ex column A to E have the below data.

    A is supplier name
    B is supplier's region
    C is Currency
    D is Product.
    E is amount

    Here I will have different suppliers who are from different region however there is a chance that supplier name could be same in different region. When the country changes the currency also would change. I would need a separate file for the suppliers who are from different regions even if their names are similar.

    Hence I need a macro to create multiple workbook based on the filtering criterias below

    Supplier Name
    Supplier's Region
    Currency

    Hope you could help me.

    Regards,
    Malai

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 10-02-2023 at 12:38 PM.

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    malaionfun,

    Welcome to ExcelFox Community.

    It would be best to upload a sample workbook that represent the layout and structure of your original workbook, so that developers here can understand the input viz a viz the output.

    Regards,
    Sam
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

  3. #3
    Junior Member
    Join Date
    Apr 2012
    Posts
    4
    Rep Power
    0

    split data into multiple workbooks with 3 conditions.

    Hi admin,

    Please find the attached sample report as requested.

    I have given the sample data in the tab one and tab 2 is the output in the format I required.

    The split file should be segregated with the below criteria

    1. Country
    2. Payment/Recovery
    3. Currency

    For Example, spain have both debit and credit with two different currency namely GBP and EUR.

    I require the separate file for each criteria, a file can contain line items of Spain, debit, GBP and new file for Spain,Debit,EUR.

    Hope this helps.

    Thanks and regards,
    Malaionfun


    Quote Originally Posted by Excel Fox View Post
    malaionfun,

    Welcome to ExcelFox Community.

    It would be best to upload a sample workbook that represent the layout and structure of your original workbook, so that developers here can understand the input viz a viz the output.

    Regards,
    Sam
    Sample report.xlsSample report.xls

  4. #4
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi,

    Try this.

    Code:
    Sub kTest()
        
        Dim k, Data As Range, x, Hdr, i As Long, Crits, s As String
        Dim wbkActive   As Workbook, wbkNew As Workbook, j As Long
        Dim FN  As String, Cols
        
        Set wbkActive = ThisWorkbook
        
        Hdr = Array("Gateway", "Supplier Code", "Formulated Column", "Supplier Code", _
                    "Reference", "Amount (£)", "Doc Currency", "Country", "Invoice Number")
        Cols = Array(3, 6, , 7, 5, 8, 9, 11, 4)
        
        Application.ScreenUpdating = False
        
        With wbkActive.Sheets("workings")
            If .AutoFilterMode Then .AutoFilterMode = False
            Set Data = .Range("a1:l" & .Range("a" & .Rows.Count).End(xlUp).Row)
            k = Data.Value2
        End With
        With CreateObject("scripting.dictionary")
            .comparemode = 1
            For i = 2 To UBound(k, 1)
                If Len(k(i, 2)) Then
                    s = k(i, 2) & "|" & k(i, 9) & "|" & k(i, 11)
                    If Not .exists(s) Then
                        .Add s, Nothing
                    End If
                End If
            Next
            k = .keys
        End With
        
        With Data
            For i = 0 To UBound(k)
                x = Split(k(i), "|")
                .AutoFilter 2, x(0), 1
                .AutoFilter 9, x(1), 1
                .AutoFilter 11, x(2)
                FN = .Offset(1).Cells(1, .Columns.Count).Value
                Set wbkNew = Workbooks.Add
                With wbkNew.Sheets(1)
                    .Range("a2:a4") = Application.Transpose([{"File Number","Payment/Recovery","Currency"}])
                    .Range("a7").Resize(, UBound(Hdr) + 1) = Hdr
                    .Range("b2") = FN
                    .Range("b3") = x(0)
                    .Range("b4") = x(1)
                End With
                On Error Resume Next
                For j = 0 To UBound(Cols)
                    .Columns(Cols(j)).Copy wbkNew.Sheets(1).Cells(8, j + 1)
                Next
                On Error GoTo 0
                wbkNew.Sheets(1).Rows(8).Delete
                wbkNew.SaveAs wbkActive.Path & "\" & FN & "-" & x(0) & "-" & x(1) & "-" & x(2), 51
                wbkNew.Close
                Set wbkNew = Nothing
            Next
            .Parent.AutoFilterMode = False
        End With
        Application.ScreenUpdating = True
        
    End Sub
    HTH
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

  5. #5
    Junior Member
    Join Date
    Apr 2012
    Posts
    4
    Rep Power
    0

    split data into multiple workbooks with 3 conditions

    Hi Admin,

    Thank you for your coding.

    I already have a excel workbook in which I paste the output of the segregated line items as the sheet 2 has a data for few formulas that I use in sheet 1 along with the output. This coding creates a new file for each output however, Is it possible to put the output data on the template file which I have.

    This means I have a file in which there is 2 sheets. I need the output data in sheet 1 and the sheet 2 should remain constant with the data whatever it has. because I need to send the output files to someone who need to work along with sheet2. Each output file should be in this format only.

    First sheet of output data which we have segregated and second sheet with default data. I guess we need to create a macro file keeping the sheet1 as template and then need to paste the data to it and then we need to save as it in the required file name.

    Is this possible to do?

    Regards,
    Malai



    Quote Originally Posted by Admin View Post
    Hi,

    Try this.

    Code:
    Sub kTest()
        
        Dim k, Data As Range, x, Hdr, i As Long, Crits, s As String
        Dim wbkActive   As Workbook, wbkNew As Workbook, j As Long
        Dim FN  As String, Cols
        
        Set wbkActive = ThisWorkbook
        
        Hdr = Array("Gateway", "Supplier Code", "Formulated Column", "Supplier Code", _
                    "Reference", "Amount (£)", "Doc Currency", "Country", "Invoice Number")
        Cols = Array(3, 6, , 7, 5, 8, 9, 11, 4)
        
        Application.ScreenUpdating = False
        
        With wbkActive.Sheets("workings")
            If .AutoFilterMode Then .AutoFilterMode = False
            Set Data = .Range("a1:l" & .Range("a" & .Rows.Count).End(xlUp).Row)
            k = Data.Value2
        End With
        With CreateObject("scripting.dictionary")
            .comparemode = 1
            For i = 2 To UBound(k, 1)
                If Len(k(i, 2)) Then
                    s = k(i, 2) & "|" & k(i, 9) & "|" & k(i, 11)
                    If Not .exists(s) Then
                        .Add s, Nothing
                    End If
                End If
            Next
            k = .keys
        End With
        
        With Data
            For i = 0 To UBound(k)
                x = Split(k(i), "|")
                .AutoFilter 2, x(0), 1
                .AutoFilter 9, x(1), 1
                .AutoFilter 11, x(2)
                FN = .Offset(1).Cells(1, .Columns.Count).Value
                Set wbkNew = Workbooks.Add
                With wbkNew.Sheets(1)
                    .Range("a2:a4") = Application.Transpose([{"File Number","Payment/Recovery","Currency"}])
                    .Range("a7").Resize(, UBound(Hdr) + 1) = Hdr
                    .Range("b2") = FN
                    .Range("b3") = x(0)
                    .Range("b4") = x(1)
                End With
                On Error Resume Next
                For j = 0 To UBound(Cols)
                    .Columns(Cols(j)).Copy wbkNew.Sheets(1).Cells(8, j + 1)
                Next
                On Error GoTo 0
                wbkNew.Sheets(1).Rows(8).Delete
                wbkNew.SaveAs wbkActive.Path & "\" & FN & "-" & x(0) & "-" & x(1) & "-" & x(2), 51
                wbkNew.Close
                Set wbkNew = Nothing
            Next
            .Parent.AutoFilterMode = False
        End With
        Application.ScreenUpdating = True
        
    End Sub
    HTH

  6. #6
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi,

    You should have mentioned this in your original post. Anyway try this. I assume that you have template file (TemplateName.xltx/TemplateName.xlt) in which on the second sheet you have your calculations.

    This code will create a new file based on the template and paste the data on First Sheet.

    Code:
    Sub kTest_v1()
        
        Dim k, Data As Range, x, Hdr, i As Long, Crits, s As String
        Dim wbkActive   As Workbook, wbkNew As Workbook, j As Long
        Dim FN  As String, Cols, TltName   As String
        
        With Application.FileDialog(3)
            .AllowMultiSelect = False
            .Title = "Select the Template File"
            .Filters.Add "Excel Template", ("*.xltx;*.xlt")
            .InitialFileName = ThisWorkbook.Path
            If .Show = -1 Then
                TltName = .SelectedItems(1)
            Else
                Exit Sub
            End If
        End With
        
        Set wbkActive = ThisWorkbook
        
        Hdr = Array("Gateway", "Supplier Code", "Formulated Column", "Supplier Code", _
                    "Reference", "Amount (£)", "Doc Currency", "Country", "Invoice Number")
        Cols = Array(3, 6, , 7, 5, 8, 9, 11, 4)
        
        Application.ScreenUpdating = False
        
        With wbkActive.Sheets("workings")
            If .AutoFilterMode Then .AutoFilterMode = False
            Set Data = .Range("a1:l" & .Range("a" & .Rows.Count).End(xlUp).Row)
            k = Data.Value2
        End With
        With CreateObject("scripting.dictionary")
            .comparemode = 1
            For i = 2 To UBound(k, 1)
                If Len(k(i, 2)) Then
                    s = k(i, 2) & "|" & k(i, 9) & "|" & k(i, 11)
                    If Not .exists(s) Then
                        .Add s, Nothing
                    End If
                End If
            Next
            k = .keys
        End With
        
        With Data
            For i = 0 To UBound(k)
                x = Split(k(i), "|")
                .AutoFilter 2, x(0), 1
                .AutoFilter 9, x(1), 1
                .AutoFilter 11, x(2)
                FN = .Offset(1).Cells(1, .Columns.Count).Value
                Set wbkNew = Workbooks.Open(TltName)
                
                With wbkNew.Sheets(1)
                    .Range("a2:a4") = Application.Transpose([{"File Number","Payment/Recovery","Currency"}])
                    .Range("a7").Resize(, UBound(Hdr) + 1) = Hdr
                    .Range("b2") = FN
                    .Range("b3") = x(0)
                    .Range("b4") = x(1)
                End With
                On Error Resume Next
                For j = 0 To UBound(Cols)
                    .Columns(Cols(j)).Copy wbkNew.Sheets(1).Cells(8, j + 1)
                Next
                On Error GoTo 0
                wbkNew.Sheets(1).Rows(8).Delete
                wbkNew.SaveAs wbkActive.Path & "\" & FN & "-" & x(0) & "-" & x(1) & "-" & x(2), 51
                wbkNew.Close
                Set wbkNew = Nothing
            Next
            .Parent.AutoFilterMode = False
        End With
        Application.ScreenUpdating = True
        
    End Sub
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Replies: 2
    Last Post: 05-28-2013, 05:32 PM
  2. Import Data From Multiple Workbooks To Another
    By Jorrg1 in forum Excel Help
    Replies: 2
    Last Post: 05-13-2013, 05:00 PM
  3. Replies: 2
    Last Post: 03-05-2013, 07:34 AM
  4. copying data from multiple workbooks into another
    By rahulcoolz99 in forum Excel Help
    Replies: 1
    Last Post: 08-22-2012, 09:19 PM
  5. Split Closed Workbook into Multiple Workbooks Using ADO
    By ramakrishnan in forum Excel Help
    Replies: 4
    Last Post: 10-02-2011, 08:34 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •