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!!

 

[FormR]

But it just takes a long time

I don't think there is much we can do about that as I suspect it's the PDF and Email creation that is taking the time and these are outside of our control.

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

Try these additions:

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)),"""")")
[COLOR=#ff0000]        If Len(sEmailAdd) Then[/COLOR]
            .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"
[COLOR=#ff0000]        End If[/COLOR]
        .Columns(i).Hidden = True
    Next i
    .Parent.PageSetup.PrintArea = oldPrintA
    .Columns.Hidden = False
    .AutoFilter
End With
End Sub

 

[FormR]

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...

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

But it puts the 'Ligging werven.PDF" in there with it, which was not what i was expecting

And it puts the 'Werven Werfleiders.PDF" in there with it, which cannot happen.

I'm confused by all of this

 

[Saschah]

I'm confused by all of this

Yea maybe my communication is a bit messy

So, what i wanted was:

"Ligging werven" - Needs to be send to all the mail adresses in its cell "G1" which is actually all the emails in our "EmailList"-table.

"Werven Werfleiders" - needs to be send to all the mail adresses in cell "G1" which are 6 other mail adresses.

Werven werfleiders is accually just a text saying that all people have gotten there piece of the schedule.
So if you can just make an automated mail macro at the end with the text we don't even need that PDF or sheet.

I hope I made it possible for you to understand me now

 

[FormR]

Hi, this doesn't do anything with the "Ligging werven" and "Werven Werfleiders" sheets - why don't you see if you can adapt your existing code to take care of what you want to happen with those.

Sub M1()
Dim i As Long, oldPrintA As String, dStart As Long, dEnd As Long, 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
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,MATCH(""" & Cells(1, i).Value & """,EmailList[Name],0)),"""")")
        If Len(sEmailAdd) Then
            .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 sFileName, sEmailAdd, "", "", "Subject", False, False, "Body"
        End If
        .Columns(i).Hidden = True
    Next i
    .Parent.PageSetup.PrintArea = oldPrintA
    .Columns.Hidden = False
    .AutoFilter
End With
End Sub
[/code]

 

[Saschah]

Hey,

I made some changes to the code.
I was thinking this should work like I wanted it too, except for the automated mail to those 5 adresses (but i figured it would be easier to just type the mail)

It makes all the PDF's I want to, the way I want to, but it doesn't open my outlook anymore and doenst make a mail anymore?
Could you check what I have done wrong?

Thanks alot!!

Sub PDFmaker()
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 = "C:\Users\Sascha\Desktop\Test map" '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" & Format(Now, "dd-mmm-yy") & ".PDF", OpenAfterPublish:=False
sAttachList = sFolder & "\Ligging Werven.PDF,"
With ActiveSheet.ListObjects(1).Range
    oldPrintA = .Parent.PageSetup.PrintArea
    For i = 4 To .Columns.Count
        sFileName = sFolder & "\" & Cells(1, i).Value & Format(Now, "dd-mmm-yy") & ".PDF"
        sEmailAdd = Evaluate("IFERROR(INDEX(EmailList[Email],MATCH(""" & Cells(1, i).Value & """,EmailList[Name],0)),"""")")
        If Len(sEmailAdd) Then
            .AutoFilter
            .AutoFilter Field:=3, Criteria1:=">=" & dStart, Operator:=xlAnd, Criteria2:="<=" & dEnd
            .Parent.PageSetup.PrintArea = .Resize(, i).Address
            .Parent.ExportAsFixedFormat Type:=xlTypePDF, FileName:=sFileName, OpenAfterPublish:=False
            RDB_Mail_PDF_Outlook sAttachList & "," & sFileName, sEmailAdd, "", "", "Planningsupdate" & Format(Now, "dd-mmm-yy"), False, False, "Beste Onderaannemer, Gelieve in bijlage de laatste voorlopige planning terug te vinden."
        End If
        .Columns(i).Hidden = True
    Next i
    .Parent.PageSetup.PrintArea = oldPrintA
    .Columns.Hidden = False
    .AutoFilter
End With
End Sub

 

[FormR]

it doesn't open my outlook anymore and doenst make a mail anymore?
Could you check what I have done wrong?

Hi, try removing this comma:

sAttachList = sFolder & "\Ligging Werven.PDF,"

Quick tip - if you have problems with the email generation try to temporarily comment out the "On Error Resume Next" line in the "RDB_Mail_PDF_Outlook" function to hopefully reveal a little more about the potential cause of the problem.

 

[Saschah]

Hi, try removing this comma:

sAttachList = sFolder & "\Ligging Werven.PDF,"

Quick tip - if you have problems with the email generation try to temporarily comment out the "On Error Resume Next" line in the "RDB_Mail_PDF_Outlook" function to hopefully reveal a little more about the potential cause of the problem.

So when i troubleshoot as your tip learned me to, it Highlights : .Attachments.Add vFileNames
in the function part

Option Explicit


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

 

[FormR]

So when i troubleshoot as your tip learned me to, it Highlights : .Attachments.Add vFileNames
in the function part

Did you try removing the errant comma from the line below as suggested?

Hi, try removing this comma:

sAttachList = sFolder & "\Ligging Werven.PDF,"