Need to edit code for extracting the same result as result file

[Pankaj Jaswani]

Hello Expert,

Greetings!

I've included a sample file with my VBA code. The code splits the workbook and its worksheets into a separate workbook based on the same column header in all worksheets. Although the code is working, it is not delivering the same results as the result file that I have uploaded. Can anyone assist me in getting the same outcome by modifying the code?

Sample File with Code and Result file is here: Filebin | 3pufl5cnj91nyhe3

 

[bebo021999]

You need to clarify what criteria to get the result.
For instant, sheet A have 10 records, and sheet A in file result is filterred to be one record. how to know which record will be choosen?

 

[Pankaj Jaswani]

Hello Bebo!

Thank you so much for replying on my thread. There is a userform in the sample file that allows us to split the workbook into a new workbook with all of its worksheets based on filtered column header criteria that we selected by choosing Worksheet and the header by the list box in the userform that allows us to select the header for splitting the workbook that will be the same in all worksheets.

Yes, bebo sheet A has 10 records, and sheet A in the file is filtered to be one record; you will also notice that the data in the result file is related to one record in all worksheets, however after pressing the button, a total of 10 files for each individual record will be created.

The MDD name in my sample file stands for distributor name, and this header appears on all sheets. Now I want to save each individual distributor file to a folder, including only its data for all worksheets. For example, if we have 10 distributors, ten individual files will be created, each containing only its data for all worksheets.

The existing macro works, but the data copy part just copies the visible data from the sample file to the result file, whereas my sample file data includes grouping, so the entire data is not pasted in the result file. Also, after making an individual file, I'd like to present the grouping in the result file as a sample file. I'm stuck in this place. That is why I am seeking assistance in modifying this part so that I can extract the exact result as a sample file to a result file for each individual record, including all worksheets.

 

[bebo021999]

Sorry it seems beyond my abilities.
Hope someone will help!

 

[Pankaj Jaswani]

Oh, but I still believe you can assist me. I'm not sure if that will work. If we first remove the grouping in the master file, which is a sample file, and then copy the data into the new workbook, we can then apply the grouping to the new sheet, which is where it is available. I have the grouping code and will attach it here if you can assist me.

we can remove the grouping by

Cells.Select
                    Selection.Columns.ClearOutline
                    Selection.EntireColumn.Hidden = False

We can add Grouping (two type) Module Code:

Sub Grouping2()
    Dim aText1R As String
    Dim aText2R As String
    Dim aText1 As String
    Dim aText2 As String
    LastColumn = ActiveSheet.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
    a = 0
    b = 0
    For i = 1 To LastColumn
        SText = Cells(2, i).Value
        nChar = InStr(SText, "'")
        If nChar > 0 Then
            aText = Split(SText, "'")
            aText1R = aText(0)
            aText2R = aText(1)
            aText1 = Len(aText1R)
            aText2 = Len(aText2R)
            If aText1 = 3 And aText2 = 2 Then
                If a = 0 Then
                    a = i 'This captures the 1st instance of a column header with an apostrophe in it
                Else
                    b = i 'This captures the last instance of a column header with an apostrophe
                End If
            Else
                If a <> 0 And b <> 0 Then
                    Range(Columns(a), Columns(b - 1)).Group 'Note the b-1 is being done so that the last month's/latest month's data is not hidden
                    Range(Columns(a), Columns(b - 1)).Hidden = True 'Note the b-1 is being done so that the last month's/latest month's data is not hidden
                    a = 0
                    b = 0
                Else
                End If
            End If
        Else
            If a <> 0 And b <> 0 Then
                Range(Columns(a), Columns(b - 1)).Group
                Range(Columns(a), Columns(b - 1)).Hidden = True
                a = 0
                b = 0
            Else
            End If
        End If
    Next i
End Sub

Sub Grouping3()
    Dim aText1R As String
    Dim aText2R As String
    Dim aText1 As String
    Dim aText2 As String
    LastColumn = ActiveSheet.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Column
    a = 0
    b = 0
    For i = 1 To LastColumn
        SText = Cells(3, i).Value
        nChar = InStr(SText, "'")
        If nChar > 0 Then
            aText = Split(SText, "'")
            aText1R = aText(0)
            aText2R = aText(1)
            aText1 = Len(aText1R)
            aText2 = Len(aText2R)
            If aText1 = 3 And aText2 = 2 Then
                If a = 0 Then
                    a = i 'Captures the 1st instance of a column heading that contains an apostrope
                Else
                    b = i 'Captures the last instance of a column heading that contains an apostrophe
                End If
            Else
                If a <> 0 And b <> 0 Then
                    Range(Columns(a), Columns(b - 1)).Group
                    Range(Columns(a), Columns(b - 1)).Hidden = True
                    a = 0
                    b = 0
                Else
                End If
            End If
        Else
            If a <> 0 And b <> 0 Then
                Range(Columns(a), Columns(b - 1)).Group 'This creates a group out of a collection of columns
                Range(Columns(a), Columns(b - 1)).Hidden = True
                a = 0
                b = 0
            Else
            End If
        End If
    Next i
End Sub