save each range contains month as pdf for specific sheet based on inputbox

Hasson

Active Member
Joined
Apr 8, 2021
Messages
386
Office Version
  1. 2016
Platform
  1. Windows
hello

I have files contain many sheets and each sheet contains data for 12 months .the data are a1:g and the column A contains date M/DD/YYYY . what I want macro to show inputbox and write the sheet after this should save all of the ranges for all the months separately not in one file . each month should be in one file for written sheet into inputbox as PDF , but when save for each month I would create the headers for each month which save as pdf . the headers in row1 , then when save for each month it should contain the headers .
the directory is D:\DATA , but when save in this directory should create folders and thier names based on sheets names and the files should save in sheet is relating of it
and if I run the macro repeatedly should pops up message " the files have already existed ,do you want replace them ? " if press ok then replace it , if press no then nothing happens .


thanks
 
That way the explanation is much better.

Try this:
VBA Code:
Sub save_month_as_pdf()
  Dim sPath As String, sFile As String, justName As String, newFile As String
  Dim wb2 As Workbook, wb3 As Workbook
  Dim sh As Worksheet, sh3 As Worksheet
  Dim i As Long, lr As Long, n As Long
  Dim resp As Variant, arr() As Variant, ky As Variant
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  sPath = "C:\Data\"     'source path xlsx files
  sFile = Dir(sPath & "*.xls*")
  
  resp = MsgBox("The files have already existed ,do you want replace them ? ", vbYesNo, "REPLACE")
  If resp = False Then Exit Sub
  
  Do While sFile <> ""
    n = n + 1
    ReDim Preserve arr(1 To n)
    arr(n) = sFile
    sFile = Dir()
  Loop
  
  For Each ky In arr
    Set wb2 = Workbooks.Open(sPath & ky)
    justName = Left(ky, InStr(1, ky, ".") - 1)
    If Dir(sPath & justName, vbDirectory) = "" Then
      MkDir sPath & justName
    End If
    For Each sh In wb2.Sheets
      If Dir(sPath & justName & "\" & sh.Name, vbDirectory) = "" Then
        MkDir sPath & justName & "\" & sh.Name
      End If
      
      If sh.AutoFilterMode Then sh.AutoFilterMode = False
      lr = sh.Range("A" & Rows.Count).End(3).Row
      For i = 1 To 12
        newFile = sPath & justName & "\" & sh.Name & "\" & "MONTH" & i & ".pdf"
        
        If resp = vbYes Or (resp = vbNo And Dir(newFile) = "") Then
          Set wb3 = Workbooks.Add(xlWBATWorksheet)
          sh.Range("A1:G" & lr).AutoFilter 1, Criteria1:=20 + i, Operator:=xlFilterDynamic
          sh.AutoFilter.Range.Copy wb3.Sheets(1).Range("A1")
            
          wb3.ExportAsFixedFormat Type:=xlTypePDF, Filename:=newFile, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
          wb3.Close False
        End If
        
      Next
    Next
    wb2.Close False
  Next
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
End Sub
 
Upvote 0

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
thanks
I have some notices:
1- why show message box despit of it there is no files PDF . I excpect showing this message if there is files PDF are already existed . from the first time when run the macro just three files are existed of xlsx type ,then should not show the message.
2- when save file as PDF it will create 12 files but based on my picture for file PUR1 should be 2 files and the names should be MONTH11, MONTH12
and the file SEARCH
2- when save file as PDF it will create 12 files but based on my picture for file SEARCH should be 3 files and the names should be MONTH3, MONTH4,MONTH5 ( note: the file name depends on name MONTH & MONTH NUMBER based on column A. e.g the month MARCH then should take number 3 for rename file)

this is what I got whether file PUR1 or SEARCH
PP.PNG


3- when open any file doesn't show any data just shows the headers
this is what I got when open any file
hd.PNG
 
Upvote 0
1- why show message box despit of it there is no files PDF . I excpect showing this message if there is files PDF are already existed . from the first time when run the macro just three files are existed of xlsx type ,then should not show the message.
The message is, if you choose "Yes", if the file exists then replace it, if it doesn't exist then create it.
If you choose "No", if the file exists then it doesn't replace it, if it doesn't exist then it creates it.
For me, a single message that will work for all files is more practical.
But if you want the message to appear for each file, if you have 100 files and there are 100 files, then the message will appear 100 times.

But it is not specified in your initial request.


2- when save file as PDF it will create 12 files but based on my picture for file PUR1 should be 2 files and the names should be MONTH11, MONTH12
and the file SEARCH
If the sheet does not have periods 1 to 10, it is not specified in your original request that it does not generate the files.

and the file SEARCH
But it is not specified in your initial request.

3- when open any file doesn't show any data just shows the headers
this is what I got when open any file

If the sheet does not have periods 1 to 10, it is not specified in your original request that it does not generate the files.

------
From the beginning your requirements have not been clear enough. You did not give examples, even though I asked for it several times. Your examples don't cover all scenarios.
As long as you make the requirements clear enough, to that extent the macro will contain everything needed.
--------
Check the dates of your file.
Open a file that has dates in the month of January, or create a file with dates in the month of January, it is to test the filter. If in your column A you don't have dates, then it doesn't filter anything. That is, if you have text that looks like a date, but is not a date, then it will not filter correctly.
So, on the file with dates in January and other months, try the following macro.
This must filter only the dates of the month of January.

VBA Code:
Sub testdate()
  Dim sh As Worksheet
  Dim lr As Long
  Set sh = ActiveSheet
  lr = sh.Range("A" & Rows.Count).End(3).Row
  sh.Range("A1:G" & lr).AutoFilter 1, Criteria1:=21, Operator:=xlFilterDynamic
End Sub

Criteria1:=21, 21 means January, 22 February , 23 March, etc... try other numbers so that you can check the results of the tests.
 
Last edited:
Upvote 0
From the beginning your requirements have not been clear enough. You did not give examples, even though I asked for it several times. Your examples don't cover all scenarios.
my apologies !
forgive me , to answer your asking to show all of details . I try to do my best .

The message is, if you choose "Yes", if the file exists then replace it, if it doesn't exist then create it.
this means also include file of xls of type . I wanted just for files pdf of type . if I run again to save files as pdf should show the message
For me, a single message that will work for all files is more practical.
yes this is correct . I agree with you
But if you want the message to appear for each file, if you have 100 files and there are 100 files, then the message will appear 100 times.
no I don't want it at all

If the sheet does not have periods 1 to 10, it is not specified in your original request that it does not generate the files.
I thought the picture shows two files PDF for file pur1 & three files PDF for file search with files names are clear , and I thought this is clear , i expected to ask me if it's not clear . I wanted generating just files which contain specific months contains data .

as to headers I was wrong . I don't open files 11,12 for file PUR1 & 3,4,5 for file SEARCH,

but there is strange case when open the file PDF is not arranged for formatting & borders as in attached picture
arr.PNG
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top