Using macros to save drilldowns with file names.

Good afternoon,

I am currently trying to create a macro where pivot table subtotals are taken and split by their client.
Once the file is opened, the columns have to be autofit, and the sheet has to be saved as the name of the client.

I've tried multiple methods without success.

Also, the potential client list is 45, and I have 30 regular ones; will I have to create it with all 45 in the pivot table in case they appear one week.

Any help would be appreciated.

Thank you.

So on the attached example I will have to click on the subtotals.
Initially B4
In this case there doesn't have to be any auto fit adjusting but in the actual data I will have to, then I want to save the file as the name of the client A.
Either from their own workbook or the summary work book.

The order of the clients might change and also some maynot be present next week, while some new ones maybe.

Is there a way to create a macro to handle this and the many variables at play.

Thank you.

I want to save the file as the name of the client A.

What's up if the file already exists ?
Is the file to be recorded in the same folder as the one with data ?
You want to fire the macro only when clicking in column "B" or do it for the full set of values ?

the files will be saved in a new folder every week.

What's the name of the folder?
Can you attach an example of the final file for a client: There is not so much information inside ...!

Is the folder' name where to store files (client backups 21.02.2020) will be manually entered or do we need to create the folder?
What is the use of "Report B" while all information is already recorded in "Report A"

For a first step see next code

Option Explicit

Sub Treat()
Const WsInN1 = "Report A"
Const WsInN2 = "Report B"
Const FdN = "client backups 21.02.2020"
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Ws1 = Sheets(WsInN1): Set Ws2 = Sheets(WsInN2)
Dim ClientDic   As Object
Set ClientDic = CreateObject("Scripting.Dictionary")
Dim WkRg  As Range, Rg As Range
Dim K
Dim WkPh As String
WkPh = ActiveWorkbook.Path & "\" & FdN
    Application.ScreenUpdating = False
    With Ws1
        .AutoFilterMode = False
        For Each Rg In Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(3)(2))
            If (Rg <> "") Then ClientDic.Item(Rg.Value) = Empty
        Next Rg
        Set WkRg = .Cells(1, 1).CurrentRegion
        For Each K In ClientDic.keys
            Workbooks.Add
            With WkRg
                .AutoFilter Field:=2, Criteria1:=K
                .SpecialCells(xlCellTypeVisible).Copy Destination:=Cells(1, 1)
            End With
            ActiveWorkbook.SaveAs WkPh & "\" & K
            ActiveWorkbook.Close
        Next K
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
    MsgBox ("Job Done")
End Sub

You're welcome

Can I send over a live version, with dummy data of course

Yes of course

your macro retrieved the information via the Pivot tables

The Pivot table is not used
The idea is to prepare a client name list from sheet "Report A" : see the use of the Dictionary
Then for each record from this list a filter is used in sheet "Report A" to select the corresponding client in column "B"
Then the complete set of visible cells is copied and pasted into a new file

As for as I have understood your need and using your last sample file this could be done, using sheet "Access" and coping and pasting only values to the new file.
In the other hand the folder where files are stored, could be prepare by the macro using for folder's name the week number of the actual day.
What do you thing ?

I'm sorry. I understand you... but at the same time I don't.

I've been trying to understand the code all night.

When i try using the macro on the new example sheet it errors here:
Set Ws1 = Sheets(WsInN1): Set Ws2 = Sheets(WsInN2)

Could you physically screen capture your steps, or annotate the macro step info please, so I can learn the code and apply it to my live data file.

The only other thing I can think of is only using the access sheet; since this one has the complete transport info aswell as the lookups...

All i need to do is tell excel to look up cons. code, split their info into a new workbook, save the file as the client name - in a folder in my desktop?



update, I've just made a macro that splits out all workbooks and saves as pdfs-- they save on my desktop, not a folder in my desktop but I have tomorrow to fix that 😂. Now I think I just need to get the first part:

Having the access data split by code, and having worksheets named by this code

Here what could be done
go step by step to see what's happening

Option Explicit

Sub Treat()
Const WsInN1 = "Access"
Const FdN = "client backups 21.02.2020"
Dim Ws1 As Worksheet
Set Ws1 = Sheets(WsInN1)
Dim ClientDic   As Object
Set ClientDic = CreateObject("Scripting.Dictionary")
Dim WkRg  As Range, Rg As Range
Dim K
Dim WkPh As String
WkPh = ActiveWorkbook.Path & "\" & FdN
    Application.ScreenUpdating = False
    With Ws1
        .AutoFilterMode = False
        For Each Rg In Range(.Cells(2, "B"), .Cells(Rows.Count, "B").End(3)(2))
            If (Rg <> "") Then ClientDic.Item(Rg.Value) = Empty
        Next Rg
        Set WkRg = .Cells(1, 1).CurrentRegion
        For Each K In ClientDic.keys
            Workbooks.Add
            With WkRg
                .AutoFilter Field:=2, Criteria1:=K
                .SpecialCells(xlCellTypeVisible).Copy Destination:=Cells(1, 1)
            End With
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=WkPh & "\" & K & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            ActiveWorkbook.Close SaveChanges:=False  ' Quit  without  saving
        Next K
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
    MsgBox ("Job Done")
End Sub

It's all working great, I just need the option to sometimes save the files as excel sheets.

What do I need to change the code to?

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=WkPh & "\" & K & ".pdf", _

I'm guessing these have to changed to xslx or something along those lines?

If you want to save as excel file see first macro
use

ActiveWorkbook.SaveAs WkPh & "\" & K

instead of

ActiveWorkbook.Close SaveChanges:=False ' Quit without saving

It's just pulling the titles, no data...

Here an update to play with column "A"

Option Explicit

Sub Treat()
Const WsInN1 = "Access"
Const FdN = "client backups 21.02.2020"
Const WkCol = 1     '  for  column A
Dim Ws1 As Worksheet
Set Ws1 = Sheets(WsInN1)
Dim ClientDic   As Object
Set ClientDic = CreateObject("Scripting.Dictionary")
Dim WkRg  As Range, Rg As Range
Dim K
Dim WkPh As String
WkPh = ActiveWorkbook.Path & "\" & FdN
    Application.ScreenUpdating = False
    With Ws1
        .AutoFilterMode = False
        For Each Rg In Range(.Cells(2, WkCol), .Cells(Rows.Count, "B").End(3)(2))
            If (Rg <> "") Then ClientDic.Item(Rg.Value) = Empty
        Next Rg
        Set WkRg = .Cells(1, 1).CurrentRegion
        For Each K In ClientDic.keys
            Workbooks.Add
            With WkRg
                .AutoFilter Field:=WkCol, Criteria1:=K
                .SpecialCells(xlCellTypeVisible).Copy Destination:=Cells(1, 1)
            End With
            ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=WkPh & "\" & K & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
            ActiveWorkbook.Close SaveChanges:=False  ' Quit  without  saving
        Next K
        .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
    MsgBox ("Job Done")
End Sub

Do you know his I can mark this as solved?

As requester you have the option to mark it as solved, have a look in the menu

Thank you once again for your help

You're welcome, so keep in mind to close the loop with a reputation (if you want): See the start on the bottom left corner

I'm learning VBA from https://youtu.be/G05TrN7nt6k

I woyuld suggest to review threads in this forum and try to solve them: I learnt a lot trying to do it and reviewing answer from others

How long do you think it'd take me to create everything I've asked you on my own from scratch?

I don't, konw, it's up to you, to the time you can spend on it, to your skill, knowledges and support: Perhaps see for a teacher to help you to start.

I tried giving rep but it's saying I need to share it out among other first haha.

You already did it , Tthank you, so nothing to tell you more on the subject