Sending a moving range of cells to different people

[Saschah]

Hey Guys,

Okay this is going to be difficult to explain...

First let me explain what I am trying to do.

I have made a big planning with 46 different people in. They all have their collum. (dates are on the rows)
They all need to get their piece of the planning.

That for the easy part..

The planning grows each week,
The days in the past remain in the planning while every week I add new weeks...
Each person needs to get their planning for the next 3 months.

So i'll try to set up an example:

We have a person C, D, F and G, named after their collums. (G's planning has multiple collums)

This week they need to get their planning as in:

C needs: Cell C5:C50
D needs: Cell D5:D50
F needs: Cell F5:F50
G needs: Cell G5:I50

Next week they need to get this planning:
C needs: Cell C10:C55
D needs: Cell D10:D55
F needs: Cell F10:F55
G needs: Cell G10:I55


So i think the moving part is the most difficult?

I have worked something out with different tabs per person but when i move stuff around it doesn't always changes which kind of makes my planning useless...

Could you guys/girls help me out?
If I didn't explained it clear enough, just let me know.

Thanks!!

 

[Saschah]

Thanks!

I'm now trying to put it all together but it remains pretty hard for a noob like me :D


I need to have the PDF's we just got to work, to get automaticly in a mail as an attachement with the correct adress filled in.
Then I need to have 2 other sheets entirely be "printed" to a pdf and also open an email with the pdf as an attachement...

I used to have a macro which makes the sheet to a pdf and makes a mail and everything. So the part of the 2 other sheets will normally be no problem..

BUUUUUUT...... :D
You have any idea how i can arange the first part?

So i need all the pdf's to get each in a sepperate mail in which there is an adres filled in so i just have to check and i can mail it.. :D

Thanks!!!!

 

[FormR]

Hi, I'm pretty much going to be away from forum now until Monday so if no one else jumps in the meantime I won't be back until then at the earliest.

I need to have the PDF's we just got to work, to get automaticly in a mail as an attachement with the correct adress filled in.
Then I need to have 2 other sheets entirely be "printed" to a pdf and also open an email with the pdf as an attachement...

..But - you'll need to provide some specifics, like how do we know what the correct email address is for each PDF? And what are the other 2 sheets called?

Might also help if you share your current macro..

 

[Saschah]

Hi, I'm pretty much going to be away from forum now until Monday so if no one else jumps in the meantime I won't be back until then at the earliest.



..But - you'll need to provide some specifics, like how do we know what the correct email address is for each PDF? And what are the other 2 sheets called?

Might also help if you share your current macro..

So... My current macro for making and sending the pdf of the sheet i got from some guys website where he puts them up for download.
This might work for sending the 2 sheets, but we'll need to find a way to send the other PDF's

'Create a PDF and mail of every sheet with a mail address in cell G1 (Sheet5 and sheet6)
'You see that the code create two mails, one with sheet5 and one with sheet6 and send it
'to the address in A1 of that sheet.


Sub Mail_Every_Worksheet_With_Address_In_G1_PDF()
'Working only in 2007 and up
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String


    'Temporary path to save the PDF files
    'You can also use another folder like
    'TempFilePath = "C:\Users\Ron\MyFolder\"
    TempFilePath = "C:\Users\Planning\Documents\Planning Archief"


    'Loop through every worksheet
    For Each sh In ThisWorkbook.Worksheets
        FileName = ""


        'Test G1 for a mail address
        If sh.Range("G1").Value Like "?*@?*.?*" Then


            'If there is a mail address in G1 create the file name and the PDF
            TempFileName = TempFilePath & "Sheet " & sh.Name & " of " _
                         & ThisWorkbook.Name & " " _
                         & Format(Now, "dd-mmm-yy h-mm-ss") & ".pdf"


            FileName = RDB_Create_PDF(Source:=sh, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)


            'If publishing is OK create the mail
            
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:=sh.Range("G1").Value, _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Planningsupdate", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<H3><B>Beste onderaannemer,</B></H3><br>" & _
                                              "******>Gelieve in bijlage de voorlopige planning terug te vinden." & _
                                              "<br><br>" & "Alvast bedankt om hiermee rekening te houden!</body>" & _
                                              "Met vriendelijke groeten,</body>" & _
                                              "<br><br>" & "Het Ecohuis-team</body>"
            Else
                MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                       "Microsoft Add-in is not installed" & vbNewLine & _
                       "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                       "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                       "You didn't want to overwrite the existing PDF if it exist"
            End If


        End If
    Next sh
End Sub

And then the functions:

Option Explicit


'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module


Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant


    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then


        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")


            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If


        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If


        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Source.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0


        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function






Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrCC As String, StrBCC As String, StrSubject As String, _
                              Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & "<br>" & .HTMLBody
        .Attachments.Add FileNamePDF
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Function






Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
                                      OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'This function will create a PDF with every sheet with
'a sheet level name variable <NamedRange> in it
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim Ash As Worksheet
    Dim sh As Worksheet
    Dim ShArr() As String
    Dim s As Long
    Dim SheetLevelName As Name


    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then


        'We fill the Array with sheets with the sheet level name variable
        For Each sh In ActiveWorkbook.Worksheets
            If sh.Visible = -1 Then
                Set SheetLevelName = Nothing
                On Error Resume Next
                Set SheetLevelName = sh.Names(NamedRange)
                On Error GoTo 0
                If Not SheetLevelName Is Nothing Then
                    s = s + 1
                    ReDim Preserve ShArr(1 To s)
                    ShArr(s) = sh.Name
                End If
            End If
        Next sh


        'We exit the function If there are no sheets with
        'a sheet level name variable named <NamedRange>
        If s = 0 Then Exit Function


        If FixedFilePathName = "" Then


            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")


            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If




        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If


        Application.ScreenUpdating = False
        Application.EnableEvents = False


        'Remember the ActiveSheet
        Set Ash = ActiveSheet


        'Select the sheets with the sheet level name in it
        Sheets(ShArr).Select


        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        ActiveSheet.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                FileName:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0


        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then
            Create_PDF_Sheet_Level_Names = Fname
        End If


        Ash.Select


        Application.ScreenUpdating = True
        Application.EnableEvents = True
    End If
End Function

 

[FormR]

So...<namedrange>

</namedrange>
Hi, try to answer the questions below - remember that all we have to go on is what you tell us

how do we know what the correct email address is for each PDF? And what are the other 2 sheets called?

 

[Saschah]

Hi, try to answer the questions below - remember that all we have to go on is what you tell us

Hi,

Yea i'm sorry I was in a hurry ...

Okay,

So the other sheets are called "Ligging Werven" and "Werfleiders"

For sending the other PDF's to get the right adresses, I was thinking maybe I can add a row under the titles and put the correct adresses in there.
Maybe it can work like I'm sending them now, with a adres in a specific cell?

But to be honest i have no clue if thats even possible...

 

[FormR]

For sending the other PDF's to get the right adresses, I was thinking maybe I can add a row under the titles and put the correct adresses in there.
Maybe it can work like I'm sending them now, with a adres in a specific cell?

How about you create another table on a new sheet (hidden if needed) that lists the column headings and their associated email addresses? - Something like this:

Excel 2013/2016
	A	B
1	Column Heading	Email Address
2	Fundering Bart	1@internet.com
3	Fundering Bruynseraede	2@internet.com
4	Fundering Ditro	3@internet.com
5	Fundering Y. Haelen	4@internet.com
6	Fundering WDB	5@internet.com
7	Fundering Kelder	6@internet.com
8	BT-Works	7@internet.com
9	Montage Johan	8@internet.com
10	Montage Miki	9@internet.com
11	Montage Timo	10@internet.com
12	Montage Roel	11@internet.com
13	Montage V. Boxelaer	12@internet.com
Sheet2

 

[Saschah]

How about you create another table on a new sheet (hidden if needed) that lists the column headings and their associated email addresses? - Something like this:

Excel 2013/2016

	A	B
1	Column Heading	Email Address
2	Fundering Bart	1@internet.com
3	Fundering Bruynseraede	2@internet.com
4	Fundering Ditro	3@internet.com
5	Fundering Y. Haelen	4@internet.com
6	Fundering WDB	5@internet.com
7	Fundering Kelder	6@internet.com
8	BT-Works	7@internet.com
9	Montage Johan	8@internet.com
10	Montage Miki	9@internet.com
11	Montage Timo	10@internet.com
12	Montage Roel	11@internet.com
13	Montage V. Boxelaer	12@internet.com

<colgroup><col style="width: 25pxpx"><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet2​

If it works, why not? :D

 

[FormR]

OK - add your new table and call it EmailList call the first column Name and the second column Email

Sub M1()
Dim i As Long, oldPrintA As String, dStart As Long, dEnd As Long, sAttachList As String, sEmailAdd As String, sFileName As String
Const sFolder As String = "H:\Temp" 'Change folder path here
dStart = Date
dEnd = DateAdd("WW", 10, dStart) '10 = number of weeks
Sheets("Ligging Werven").ExportAsFixedFormat Type:=xlTypePDF, FileName:=sFolder & "\Ligging Werven.PDF", OpenAfterPublish:=False
Sheets("Werfleiders").ExportAsFixedFormat Type:=xlTypePDF, FileName:=sFolder & "\Werfleiders.PDF", OpenAfterPublish:=False
sAttachList = sFolder & "\Ligging Werven.PDF," & sFolder & "\Werfleiders.PDF"
With ActiveSheet.ListObjects(1).Range
    oldPrintA = .Parent.PageSetup.PrintArea
    For i = 4 To .Columns.Count
        sFileName = sFolder & "\" & Cells(1, i).Value & ".PDF"
        sEmailAdd = Evaluate("IFERROR(INDEX(EmailList[Email],MATCH(""" & Cells(1, i).Value & """,EmailList[Name],0)),"""")")
        .AutoFilter
        .AutoFilter Field:=3, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:="<=" & dEnd
        .AutoFilter Field:=i, Criteria1:="<>"
        .Parent.PageSetup.PrintArea = .Resize(, i).Address
        .Parent.ExportAsFixedFormat Type:=xlTypePDF, FileName:=sFileName, OpenAfterPublish:=False
        RDB_Mail_PDF_Outlook sAttachList & "," & sFileName, sEmailAdd, "", "", "Subject", False, False, "Body"
        .Columns(i).Hidden = True
    Next i
    .Parent.PageSetup.PrintArea = oldPrintA
    .Columns.Hidden = False
    .AutoFilter
End With
End Sub

And replace the "RDB_Mail_PDF_Outlook" function with this slightly modified version:

Function RDB_Mail_PDF_Outlook(FileNamePDF As String, StrTo As String, _
                              StrCC As String, StrBCC As String, StrSubject As String, _
                              Signature As Boolean, Send As Boolean, StrBody As String)
    Dim OutApp As Object
    Dim OutMail As Object
    Dim vFileNames As Variant


    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)


    On Error Resume Next
    With OutMail
        If Signature = True Then .Display
        .To = StrTo
        .CC = StrCC
        .BCC = StrBCC
        .Subject = StrSubject
        .HTMLBody = StrBody & "" & .HTMLBody
        For Each vFileNames In Split(FileNamePDF, ",")
            .Attachments.Add vFileNames
        Next vFileNames
        If Send = True Then
            .Send
        Else
            .Display
        End If
    End With
    On Error GoTo 0


    Set OutMail = Nothing
    Set OutApp = Nothing
End Function

 

[Saschah]

Okay,

So i made the new table as you told me.
Put the code in the file..

But....
Now it automaticly makes a mail (which is a good thing )
But it puts the 'Ligging werven.PDF" in there with it, which was not what i was expecting but is actually a good thing.
And it puts the 'Werven Werfleiders.PDF" in there with it, which cannot happen.

Also it now makes 1PDF , then opens the mail and waits with the rest until i have send that mail.
With my previous macro it made all the mails at once, which meant i could just click +- 40 times on send and it was ready.
Can you get it to work like that too?

Btw, i think you are doing a fantastic job!!!

 

[Saschah]

Okay,

So i made the new table as you told me.
Put the code in the file..

But....
Now it automaticly makes a mail (which is a good thing )
But it puts the 'Ligging werven.PDF" in there with it, which was not what i was expecting but is actually a good thing.
And it puts the 'Werven Werfleiders.PDF" in there with it, which cannot happen.

Also it now makes 1PDF , then opens the mail and waits with the rest until i have send that mail.
With my previous macro it made all the mails at once, which meant i could just click +- 40 times on send and it was ready.
Can you get it to work like that too?

Btw, i think you are doing a fantastic job!!!

okay, it seems i was wrong, it does create them before i click send.
But it just takes a long time

Also...

Is it possible it ignores the ones without a mail adres?