Save to different folder according to cell value (adjust my macro)

[Lux Aeterna]

Hello precious forumers!!

I've got a macro that saves as PDF. Now I'd like to adjust it in order to save to a different folder according to the value of cell F7 on sheet Test pap.
The path I use at the moment is C:\Users\pc50\Desktop\New results\

Thank you in advance!

Sub ÁðïèÞêåõóç()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    If Sheets("Test pap").Range("U2") = "" Then
        MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Test pap").Range("U2").Select
        Exit Sub
    End If
    If Sheets("Test pap").Range("U3") = "" Then
        MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Test pap").Range("U3").Select
        Exit Sub
    End If
    Set ID = Sheets("List" & Range("Y2").Value).Range("A:A").Find(Sheets("Test pap").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If ID.Offset(, 1) <> "" Then
            If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
                & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
                ID.Offset(, 1) = Sheets("Test pap").Range("AB9")
                ID.Offset(, 38) = Sheets("Test pap").Range("A45")
                ID.Offset(, 39) = Sheets("Test pap").Range("A46")
            Else
                Sheets("Test pap").Range("U2:X3").ClearContents
                Sheets("Test pap").Range("U2:X2").Select
                MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
                Exit Sub
            End If
        Else
            ID.Offset(, 1) = Sheets("Test pap").Range("AB9")
            ID.Offset(, 38) = Sheets("Test pap").Range("A45")
            ID.Offset(, 39) = Sheets("Test pap").Range("A46")
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\pc50\Desktop\New results\" & Range("AH1").Value _
        , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    Else
        MsgBox ("Ôï ID " & Sheets("Test pap").Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí ñáíôåâïý " & Sheets("Test pap").Range("Y2") & "." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü Ýôïò êáé ôï óùóôü ID.")
        Sheets("Test pap").Range("U2:X3").ClearContents
        Sheets("Test pap").Range("U2:X2").Select
        Exit Sub
    End If
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

 

[HaHoBe]

Hi Lux Aeterna,

Test pap F7 holds both folder and Name for PDF:

       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:=Worksheets("Test pap").Range("F7").Value, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True

Test pap F7 holds only the new path (mind the backslash at the end in that cell):

       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:=Worksheets("Test pap").Range("F7").Value & Range("AH1").Value, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True

Ciao,
Holger

 

[Lux Aeterna]

Hi Lux Aeterna,

Ciao,
Holger

Hey, Holger!

I might haven't explained my request well (or didn't paste macro aprropriately).

What I need is each pdf that I print to be saved to a different folder. The name of the folder will be the value from Sheet Test pap, cell F7.

At the moment, I save all files at C:\Users\pc50\Desktop\New results\

If F7 value is "Finalised", I'd like the macro to save pdf at C:\Users\pc50\Desktop\New results\Finalised\
If F7 value is "Pending", I'd like the macro to save pdf at C:\Users\pc50\Desktop\New results\Pending\
etc.

File name remains as is (AH1 value), regardless of the folder that it is saved to.

By the way, a create folder option if it doesn't already exist would be great!

Thanks again!

 

[HaHoBe]

Hi Lux Aeterna,

if Worksheets("Test pap").Range("F7") is like "Finalised" or "Pending" you would need to add a backslash after that value like

       ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
          Filename:="C:\Users\pc50\Desktop\New results\" & Worksheets("Test pap").Range("F7").Value & "\" & Range("AH1").Value, _
          Quality:=xlQualityStandard, _
          IncludeDocProperties:=True, _
          IgnorePrintAreas:=False, _
          OpenAfterPublish:=True

For an additional check if the folder exists I introduced a new variable and a constant:

Sub ÁðïèÞêåõóç()
    Application.ScreenUpdating = False
    Dim ID As Range, sup As String, sID As String
    Dim strPath As String
    
    Const cstrMyBase As String = "C:\Users\pc50\Desktop\New results\"
    
    If Sheets("Test pap").Range("U2") = "" Then
        MsgBox ("Ôï ID äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Test pap").Range("U2").Select
        Exit Sub
    End If
    If Sheets("Test pap").Range("U3") = "" Then
        MsgBox ("Ôï êßôñéíï êåëß äåí ìðïñåß íá åßíáé êåíü.")
        Sheets("Test pap").Range("U3").Select
        Exit Sub
    End If
    Set ID = Sheets("List" & Range("Y2").Value).Range("A:A").Find(Sheets("Test pap").Range("U2").Value, LookIn:=xlValues, lookat:=xlWhole)
    If Not ID Is Nothing Then
        If ID.Offset(, 1) <> "" Then
            If MsgBox("Ôï áðïôÝëåóìá Ý÷åé Þäç äïèåß áðü " & ID.Offset(, 37) & "." & Chr(10) _
                & "Èåò ïðùóäÞðïôå íá ôï áíôéêáôáóôÞóåéò;", vbYesNo + vbDefaultButton2) = vbYes Then
                ID.Offset(, 1) = Sheets("Test pap").Range("AB9")
                ID.Offset(, 38) = Sheets("Test pap").Range("A45")
                ID.Offset(, 39) = Sheets("Test pap").Range("A46")
            Else
                Sheets("Test pap").Range("U2:X3").ClearContents
                Sheets("Test pap").Range("U2:X2").Select
                MsgBox ("Âåâáéþóïõ üôé ôá óôïé÷åßá ðïõ êáôá÷þñçóåò áöïñïýí ôï óùóôü äåßãìá! Áí ü÷é, ðÜôá êáèáñéóìü!")
                Exit Sub
            End If
        Else
            ID.Offset(, 1) = Sheets("Test pap").Range("AB9")
            ID.Offset(, 38) = Sheets("Test pap").Range("A45")
            ID.Offset(, 39) = Sheets("Test pap").Range("A46")
        End If
        strPath = cstrMyBase & Worksheets("Test pap").Range("F7").Value
        If Dir(strPath, vbDirectory) = "" Then
          MkDir strPath
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
           Filename:=strPath & "\" & Range("AH1").Value, _
           Quality:=xlQualityStandard, _
           IncludeDocProperties:=True, _
           IgnorePrintAreas:=False, _
           OpenAfterPublish:=True
    Else
        MsgBox ("Ôï ID " & Sheets("Test pap").Range("U2") & " äåí õðÜñ÷åé óôç ëßóôá ôùí ñáíôåâïý " & Sheets("Test pap").Range("Y2") & "." & Chr(10) & "¸ëåãîå üôé Ýâáëåò ôï óùóôü Ýôïò êáé ôï óùóôü ID.")
        Sheets("Test pap").Range("U2:X3").ClearContents
        Sheets("Test pap").Range("U2:X2").Select
        Exit Sub
    End If
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

The reason for misunderstandings may be found on either side - I was not sure I had understood the request correctly.

I hope this comes near to what you want.

Holger

 

[Lux Aeterna]

Holger

Thanks for the macro!

The first one works great!

The second one, that creates the folder if it doesn't already exist, will give me a debug error here

 

[HaHoBe]

Hi,

is Range("AH1") on the sheet to printout filled or is it a blank? Can you please share the error number/description? Has the folder been added as wanted before?

On a quick test with the latter parts of the code an error was raised as the cell AH1 was blank.

Holger

 

[Lux Aeterna]

Hi,

is Range("AH1") on the sheet to printout filled or is it a blank? Can you please share the error number/description? Has the folder been added as wanted before?

On a quick test with the latter parts of the code an error was raised as the cell AH1 was blank.

Holger

AH1 is outside print area. It's content is a combination of the content of two other cells and it's never blank.

I haven't added the folder in the save location. I'd like the macro to create the folder inside the "new results" directory

 

[Lux Aeterna]

I'll give you the rest details tomorrow when I get to work, thanks!

 

[HaHoBe]

Hi Lux Aeterna,

I'd like the macro to create the folder inside the "new results" directory

Did you add the codelines

'...
    Dim strPath As String
    
    Const cstrMyBase As String = "C:\Users\pc50\Desktop\New results\"
'...
            ID.Offset(, 39) = Sheets("Test pap").Range("A46")
        End If
        strPath = cstrMyBase & Worksheets("Test pap").Range("F7").Value
        If Dir(strPath, vbDirectory) = "" Then
          MkDir strPath
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
'...

to your project?

Holger

 

[Lux Aeterna]

Hi Lux Aeterna,



Did you add the codelines

'...
    Dim strPath As String
    
    Const cstrMyBase As String = "C:\Users\pc50\Desktop\New results\"
'...
            ID.Offset(, 39) = Sheets("Test pap").Range("A46")
        End If
        strPath = cstrMyBase & Worksheets("Test pap").Range("F7").Value
        If Dir(strPath, vbDirectory) = "" Then
          MkDir strPath
        End If
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
'...

to your project?

Holger

Hey, Holger!

Sorry I got back so late. I was on a leave and then life got crazy.

I tried your code again and it works perfectly! Don't know why it would give me an error the other time.

Save path at the moment is C:\Users\pc50\Desktop\New results\F7_value\

I think I might need an extra addition if possible. To have the Y2_value folder before the F7_value folder .

So the save path would be C:\Users\pc50\Desktop\New results\Y2_value\F7_value\

I also need Y2 forder to be created if it doesn't already exist.

Thank you in advance!

P.S. I try to learn from your codes and adjust similar macros on the same project!