Need to Save current sheet to one of two files depending on data ( Q or I)

[carlandtina02]

Hi there,

I have some code below that converts the current sheet to a PDF then uses data from B16, H8 and H10 to save as its filename, then it saves it to a certain file.

What I would like it to do is :

1) Convert active sheet to PDF.
2) Use the data from cells B16,H8 and H10 to save as the filename.
3) Check to see if cell H8 contains the letter Q if true then save file to C:\Documents and Settings\carl.walker\My Documents\Quotations\.
4) Check to see if cell H8 contains the letter I if true then save file to C:\Documents and Settings\carl.walker\My Documents\Invoices\.
5) Oh and still use the IF's and msgboxes.

I'm not really sure where to start to honest so any help would be much appreciated

Thanks in advance
Carl

Sub SaveActivesheet()

 Const strPath As String = "C:\Documents and Settings\carl.walker\My Documents\Reports\"
 Dim strFile As String

 With Sheet2
 'check that Account Details are present (customer's name)'
 If .Range("B16").Value = "" Then
 MsgBox "Please enter Account Details by using the ADD ACCOUNT Userform provided. ", _
 vbExclamation, "Missing Account"
 
 'check that Date is present'
 ElseIf .Range("H10").Value = "" Then
 MsgBox "Please enter a date. ", _
 vbExclamation, "Missing Date"

 'check that a Quotation or Invoice number is present '
 ElseIf .Range("H8").Value = "" Then
 MsgBox "Please enter a Quotation or Invoice number. ", _
 vbExclamation, "Missing Quotation or Invoice number"

Else
strFile = .Range("B16").Value & " " & .Range("H10").Value & " " & .Range("H8").Value
 .Copy 'Copy sheet2 to a new workbook

 ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
 strPath & strFile & ".pdf", Quality:= _
 xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
 OpenAfterPublish:=False

 MsgBox "This has now been converted to PDF and has been saved in the Quotations and Invoices folder. ", _
 vbExclamation, "Successfully Saved"
 
 End If
 End With
 End Sub

[Debraj Roy]

Try this..

        Sub SaveActivesheet()

         Const strPath As String = "C:\Documents and Settings\carl.walker\My Documents\"
         Dim strFile As String

         With Sheet2
         'check that Account Details are present (customer's name)'
         If .Range("B16").Value = "" Then
         MsgBox "Please enter Account Details by using the ADD ACCOUNT Userform provided. ", _
         vbExclamation, "Missing Account"
         
         'check that Date is present'
         ElseIf .Range("H10").Value = "" Then
         MsgBox "Please enter a date. ", _
         vbExclamation, "Missing Date"

         'check that a Quotation or Invoice number is present '
         ElseIf .Range("H8").Value = "" Then
         MsgBox "Please enter a Quotation or Invoice number. ", _
         vbExclamation, "Missing Quotation or Invoice number"

        Else
    Select Case .Range("H8")
        Case "Q":
            strPath = strPath & "Quotations\"
        Case "I":
            strPath = strPath & "Invoice\"
        Case Else
            strPath = strPath & "Reports\"
    End Select

        strFile = .Range("B16").Value & " " & .Range("H10").Value & " " & .Range("H8").Value
         .Copy 'Copy sheet2 to a new workbook

         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         strPath & strFile & ".pdf", Quality:= _
         xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
         OpenAfterPublish:=False

         MsgBox "This has now been converted to PDF and has been saved in the Quotations and Invoices folder. ", _
         vbExclamation, "Successfully Saved"
         
         End If
         End With
         End Sub

[carlandtina02]

Hi Deb,

Thanks for replying, I've just ran the code but it's sprung up with a compile error (assignment to constant not permitted)?

        Else
    Select Case .Range("H8")
        Case "Q":
            strPath = strPath & "Quotations\"
        Case "I":
            strPath = strPath & "Invoice\"
        Case Else
            strPath = strPath & "Reports\"
    End Select

Also forgot to add that I have taken away the reports folder and replaced it with a Quotation folder and a Invoice folder.


Regards
Carl

[Debraj Roy]

OOPS.. my appologize..

Please delete keyword Const from the 1st line, and use just Dim

[carlandtina02]

Hi Deb,

I just tried and its flagged up as "syntax error"?

  Sub SaveActivesheet()

        Dim strPath As String = "C:\Documents and Settings\carl.walker\My Documents\"         
         Dim strFile As String

         With Sheet2
         'check that Account Details are present (customer's name)'
         If .Range("B16").Value = "" Then
         MsgBox "Please enter Account Details by using the ADD ACCOUNT Userform provided. ", _
         vbExclamation, "Missing Account"
         
         'check that Date is present'
         ElseIf .Range("H10").Value = "" Then
         MsgBox "Please enter a date. ", _
         vbExclamation, "Missing Date"

         'check that a Quotation or Invoice number is present '
         ElseIf .Range("H8").Value = "" Then
         MsgBox "Please enter a Quotation or Invoice number. ", _
         vbExclamation, "Missing Quotation or Invoice number"

        Else
    Select Case .Range("H8")
        Case "Q":
            strPath = strPath & "Quotations\"
        Case "I":
            strPath = strPath & "Invoice\"
        Case Else
            strPath = strPath & "Reports\"
    End Select

        strFile = .Range("B16").Value & " " & .Range("H10").Value & " " & .Range("H8").Value
         .Copy 'Copy sheet2 to a new workbook

         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         strPath & strFile & ".pdf", Quality:= _
         xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
         OpenAfterPublish:=False

         MsgBox "This has now been converted to PDF and has been saved in the Quotations and Invoices folder. ", _
         vbExclamation, "Successfully Saved"
         
         
         End If
         End With
         End Sub

Kind Regards
Carl

[carlandtina02]

Hi,

Can anyone help with this pretty pleeeeaaaaaaase?

Regards
Carl

[carlandtina02]

Hi Folks,

Can anyone give me any advice with the above please?


Thanks in advance
Kind regards
Carl

[Debraj Roy]

Hi Carl!

Sorry.. I missed this post.. ;(

try this..

  Sub SaveActivesheet()

        Dim strPath As String
        strPath = "C:\Documents and Settings\carl.walker\My Documents\"
         Dim strFile As String

         With Sheet2
         'check that Account Details are present (customer's name)'
         If .Range("B16").Value = "" Then
         MsgBox "Please enter Account Details by using the ADD ACCOUNT Userform provided. ", _
         vbExclamation, "Missing Account"
         
         'check that Date is present'
         ElseIf .Range("H10").Value = "" Then
         MsgBox "Please enter a date. ", _
         vbExclamation, "Missing Date"

         'check that a Quotation or Invoice number is present '
         ElseIf .Range("H8").Value = "" Then
         MsgBox "Please enter a Quotation or Invoice number. ", _
         vbExclamation, "Missing Quotation or Invoice number"

        Else
    Select Case .Range("H8")
        Case "Q":
            strPath = strPath & "Quotations\"
        Case "I":
            strPath = strPath & "Invoice\"
        Case Else
            strPath = strPath & "Reports\"
    End Select

        strFile = .Range("B16").Value & " " & .Range("H10").Value & " " & .Range("H8").Value
         .Copy 'Copy sheet2 to a new workbook

         ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
         strPath & strFile & ".pdf", Quality:= _
         xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
         OpenAfterPublish:=False

         MsgBox "This has now been converted to PDF and has been saved in the Quotations and Invoices folder. ", _
         vbExclamation, "Successfully Saved"
         
         
         End If
         End With
         End Sub

[carlandtina02]

Cheers Deb,

Not a problem, I've just ran the code and it worked fine, Just one question..is there a way to make case Q or I non case sensitive because it saves to the report folder when they are in lowercase?

Thanks for your help with this, it's much apreciated!

Regards
Carl

[Debraj Roy]

Try This..

Sub SaveActivesheet()

Dim strPath As String
strPath = "C:\Documents and Settings\carl.walker\My Documents\"
Dim strFile As String

With Sheet2
    'check that Account Details are present (customer's name)'
    If .Range("B16").Value = "" Then
        MsgBox "Please enter Account Details by using the ADD ACCOUNT Userform provided. ", _
        vbExclamation, "Missing Account"
        
        'check that Date is present'
    ElseIf .Range("H10").Value = "" Then
        MsgBox "Please enter a date. ", _
        vbExclamation, "Missing Date"
        
        'check that a Quotation or Invoice number is present '
    ElseIf .Range("H8").Value = "" Then
        MsgBox "Please enter a Quotation or Invoice number. ", _
        vbExclamation, "Missing Quotation or Invoice number"
        
    Else
        Select Case .Range("H8")
        Case "Q", "q"
            strPath = strPath & "Quotations\"
        Case "I", "i"
            strPath = strPath & "Invoice\"
        Case Else
            strPath = strPath & "Reports\"
        End Select
        
        strFile = .Range("B16").Value & " " & .Range("H10").Value & " " & .Range("H8").Value
        .Copy 'Copy sheet2 to a new workbook
        
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        strPath & strFile & ".pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
        
        MsgBox "This has now been converted to PDF and has been saved in the Quotations and Invoices folder. ", _
        vbExclamation, "Successfully Saved"
        
        
    End If
End With
End Sub

[carlandtina02]

Thanks Deb,

It worked a treat.


Kind Regards
Carl

[Debraj Roy]

Thanks for the feedback..