Jump to content
News Ticker
  • Welcome to the Community
  • Use the forum to troubleshoot your Excel & VBA Problems
  • We will be launching a new website soon! www.ExcelWTF.com/Learn ! Join us to learn VBA from the ground up!

All Activity

This stream auto-updates     

  1. Earlier
  2. ZiyaSepp

    Use SelectionChange Event to Switch Chart

    oooh I see, very clever! Thanks for this. I love all the new emojis by the way haha 🤪 I'll no doubt be back soon with other questions, i''ve got some other ideas I'd love to implement Z
  3. Caleeco

    Use SelectionChange Event to Switch Chart

    Ah, that's not a VITAL bit of code.. it's just generally good practice when using the SelectionChange Event. It basically prevents the code running if you select more than one cell with your mouse. Eg... if you selected both B3 and B4 at the same time, the code will get confused and not trigger either event! 😵 Glad it worked 😊 Caleeco
  4. ZiyaSepp

    Use SelectionChange Event to Switch Chart

    Hi Caleeco! That works great... only 3 lines of code!? 😵 I thought it would be way more complicated haha Im trying to decipher what you've done.. i get most of it, except this line: If Target.Count > 1 Whats that supposed to do? Z
  5. Caleeco

    Use SelectionChange Event to Switch Chart

    Hello Ziya Good to see you again. That's an awesome idea! Certainly something we can use the SelectionChange Event to implement. Try this code out and see if it does what you need. Obviously you'll need to align your charts up first & past the code in the relevant SHEET object and not a VBA module. Private Sub Worksheet_SelectionChange(ByVal Target As Range) '//--- Source: www.ExcelWTF.com '//--- Purpose: Quick Switch between charts If Target.Count > 1 Or Intersect(Target, Range("B3:B4")) Is Nothing Then Exit Sub If Target.Address = "$B$3" Then ActiveSheet.Shapes("Chart 1").ZOrder msoBringToFront If Target.Address = "$B$4" Then ActiveSheet.Shapes("Chart 2").ZOrder msoBringToFront End Sub Hope That Helps Caleeco 😎
  6. Hey Caleeco, I'm upgrading my dashboard with some new charts, however, space is a premium as most people in the office work on small laptop screens! 😶 Would you be able to help me with something i've dreamt up? Basically... i want to stack 2 charts one on top of the other. Then be able to click on Cell B3 to bring the first chart to the front (hiding the other one behind it), or click cell B4 to bring the second chart to the front. So it will look like they're coming out of nowhere 😁 My Chart names are 'Chart 1' and 'Chart 2' if you need them. Can you write some VBA magic? Z
  7. Hey Sapron, Awesome, glad we could finally get it working! No problem, I'm always happy to help where I can. Ok great, I look forward to hearing from you on the near future then Caleeco
  8. Hi Caleeco, thanks for the addition, it works great now. With this addition it will prevent to send the emails twice. If you have 2 persons, no problem, but a team can also be 20 persons, that is why I want to prevent sending double emails. But it works fine now. Finally it's done ! Thank you so much for you time spent in this case. You really helped me a lot !! I wish I could thank you personally, but that's not possible unfortunately. Thank you !! You rock dude!! Ps. I will come back to you later this month with the conditional formatting case... Sapron75
  9. ZiyaSepp

    Want to learn VBA?

    Hey Cal, Just checked out your other side... looks pretty slick I will be browsing! Hopefully I'll be less of a Excel Newbie soon enough Z
  10. Hi Sapron, Good spot! Great to see you got that figured out! I was a bit confused by that code.. The variable TemplateBonusgrAfhank doesnt actually get used anywhere, so i ignored it. TemplName = .Range("D1").Value If TemplName <> .Range("Z" & CustRow).Value And TemplName = .Range("AB" & CustRow).Value Then The line above is doing the following: IF Template Name (Cell D1) Is not found in row Z of each team member AND Template Name (Cell D1) is the same as row AB of each team memeber THEN run the code I didnt see the point of line 1 above. Surely row Z and AB should always match? Either way the line I replaced it with is shown below: If wsAdd.Range("W" & r.Row).Value = arrManagerUnique(i) And wsAdd.Range("AB" & r.Row).Value = wsAdd.Range("D1").Value Then Can you explain what the code isn't doing? Preferably with an example, and I'll see what code edits are needed. If you need my code to match exactly the original requirements, this should work: If wsAdd.Range("W" & r.Row).Value = arrManagerUnique(i) And wsAdd.Range("AB" & r.Row).Value = wsAdd.Range("D1").Value and wsAdd.Range("Z" & r.Row).Value <> wsAdd.Range("D1").Value Then Look forward to hearing from you Caleeco
  11. Hi Caleeco, I found the problem. I needed to check the "Microsoft Word 14.0 Object Library" in "Tools-References". Now it works almost great :-) Almost for the part that I do can run the macro twice although there is a timestamp and "template used" available. So I checked the code and saw that this wasn't in : LastRow = .Range("C999").End(xlUp).Row 'Laatste rij in tabel bepalen For CustRow = 6 To LastRow TemplateBonusgrAfhank = .Range("AB" & CustRow).Value If TemplName <> .Range("Z" & CustRow).Value And TemplName = .Range("AB" & CustRow).Value Then I think this is the missing piece, but I can't integrate it in your code. Can you do this, then the code will be finished finally :-) Thanks again for all your effort and helping with this one ! Hope to hear from you very soon. Sapron
  12. Hi Sapron, That is very strange.. i just tested the code again, with Existing Word docs open... and with no Word docs open.. and the emails generate as expected. Is there an error code that pops-up in the message box? I presume, you're working in the same version of excel... and in the same excel file (not saved as an older version of excel). We may need to switch to late binding. If you run the code i posted two posts ago.. do you get the same error? Let me know Thanks Caleeco
  13. Hi Caleeco, first thing I get is an error I didn't get this morning...strange... It sais that "Dim WordContent As Word.Range" has not been defined. Do you see straight away where the problem lies ? Thanks and then I can test it big time :-)
  14. This is already in the code... is it not triggering correctly? Thanks for the pointers... LOL at item 6 I should have guessed that. I think i have addressed all of the above, please see the beast of a code below! Sub CreateBonusMessage() '// Source: www.ExcelWTF.com Dim wsAdd, wsTemp As Worksheet Dim arrManager As Variant Dim arrManagerUnique As New Collection Dim a As Variant Dim i As Long, lr As Long, CustCol As Long Dim WordDoc, WordApp, OutApp, OutMail As Object Dim WordContent As Word.Range Dim r As Range, RNG As Range Dim DocLoc As String Dim wordFilename As String, pdfFilename As String, FileTypeOption As String, OutputOption As String Set wsAdd = Sheets("Adressen def") Set wsTemp = Sheets("Templates") DocLoc = wsTemp.Range("B" & wsAdd.Range("B3").Value).Value 'Word document naam '//------ Ensure a Template is selected If wsAdd.Range("B3").Value = Empty Then MsgBox "Please select a correct template from the drop down list" wsAdd.Range("D1").Select Exit Sub End If '//------ Create a Unique list of Manager Names lr = wsAdd.Range("D" & Rows.Count).End(xlUp).Row arrManager = wsAdd.Range("W6:W" & lr) On Error Resume Next For Each a In arrManager arrManagerUnique.Add a, a Next a '//------ Identify the Team Members that report to each manager Set RNG = wsAdd.Range("D6:D" & lr) For i = 1 To arrManagerUnique.Count '//------ Create Outlook object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.Createitem(0) '//------ Create Word object Set WordApp = GetObject("Word.Application") If Err.Number <> 0 Then Err.Clear 'Nieuw Word sessie starten Set WordApp = CreateObject("Word.Application") WordApp.Visible = True 'Maakt Word zichtbaar voor gebruiker End If '//------ Define Email and Output Options FileTypeOption = wsAdd.Range("G1").Value OutputOption = wsAdd.Range("G2").Value For Each r In RNG If wsAdd.Range("W" & r.Row).Value = arrManagerUnique(i) And wsAdd.Range("AB" & r.Row).Value = wsAdd.Range("D1").Value Then '//------ Create Word Document Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open de template For CustCol = 3 To 20 TagName = wsAdd.Cells(5, CustCol).Value 'Je geeft de rijnummer op waarin de tags staan vermeld TagValue = wsAdd.Cells(r.Row, CustCol).Value ' Tag waarde With WordDoc.Content.Find .Text = TagName .Replacement.Text = TagValue .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll 'Forward:=True, Wrap:=wdFindContinue End With Next CustCol '//------ Create Word/PDF Document depending on Dropdown wordFilename = ThisWorkbook.Path & "\temp\" & wsAdd.Range("C" & r.Row).Value & " " & wsAdd.Range("F" & r.Row).Value & " " & wsAdd.Range("G" & r.Row).Value & " " & wsAdd.Range("H" & r.Row).Value & " - " & wsAdd.Range("U" & r.Row).Value & ".docx" pdfFilename = ThisWorkbook.Path & "\temp\" & wsAdd.Range("C" & r.Row).Value & " " & wsAdd.Range("F" & r.Row).Value & " " & wsAdd.Range("G" & r.Row).Value & " " & wsAdd.Range("H" & r.Row).Value & " - " & wsAdd.Range("U" & r.Row).Value & ".pdf" If FileTypeOption = "Word" Then WordDoc.SaveAs wordFilename ElseIf FileTypeOption = "PDF" Then WordDoc.ExportAsFixedFormat OutputFileName:=pdfFilename, ExportFormat:=wdExportFormatPDF WordDoc.Close False End If '//------ Record Template used and time it was created wsAdd.Range("Z" & r.Row).Value = wsAdd.Range("D1").Value wsAdd.Range("AA" & r.Row).Value = Now '//------ Print Word/PDF Document depending on Dropdown If OutputOption = "Print" Then WordDoc.PrintOut '//------ Create Email and add Attachments If OutputOption = "Email" Then With OutMail .Display .To = wsAdd.Range("W" & r.Row).Value .CC = wsAdd.Range("X" & r.Row).Value & ";" & wsAdd.Range("Y" & r.Row).Value .Subject = "Bonus letter(s) of your team" .Body = "Dear " & wsAdd.Range("D" & r.Row).Value & " , attached you will find the bonus letter(s) for your team. Please ensure they receive this letter individually within 1 week after receiving this e-mail." If FileTypeOption = "Word" Then .Attachments.Add wordFilename If FileTypeOption = "PDF" Then .Attachments.Add pdfFilename End With If FileTypeOption = "Word" Then Kill (wordFilename) If FileTypeOption = "PDF" Then Kill (pdfFilename) End If End If Next r 'OutMail.send WordApp.Quit Next i End Sub Let me know if you experience any problems with it! Kind regards Caleeco
  15. Hi Caleeco, you rock man !!! I can't test the printing yet (next week), but the rest is exactly what I need. 1) Indeed the time stamp, very important! I assume this is the code you will use after the pdf or word is saved : .Range("Z" & CustRow).Value = TemplName .Range("AA" & CustRow).Value = Now 2) Printer I will test next week 3) I simply would say "Kill (wordFilename)" and "Kill (pdfFilename)" somewhere at the end :-) 4) Only code for closing Word, not Outlook, because I always have to review before I definitely send. So the email must be ready to send, and not immediately, so please set it on ".Display" . And Outlook is always running on my pc, so no need to close that. 5) I tested the outmail.send and works like a charm, but as said, must be set to .display 6) When you tidy up, can you adjust the variables for print/email and pdf/word. I didn't realize those 2 are just the headers for making a choice, so it's either print or email, and either word or pdf, so no doubles. Sorry for missing that earlier. This simplifies the code a bit. Again sorry !! Can you also put in this code when you are going to open Word ? On Error Resume Next Set WordApp = GetObject("Word.Application") If Err.Number <> 0 Then Err.Clear Just to avoid problems when Word already running. Probably not...but just to be sure :-) Thanks again !!! Sapron
  16. Hi Sapron, Looks like we're nearly there! I have got the code to create a mixture of Word/PDFs as required, and can attach multiple files to each email. Could you please do some testing on the current code to also confirm this? Please note my Output location for the PDF/Word files is to a 'temp' folder, so please create the subfolder in the same directory. Sub CreateBonusMessage() Dim wsAdd, wsTemp As Worksheet Dim arrManager As Variant Dim arrManagerUnique As New Collection Dim a As Variant Dim i As Long, lr As Long Dim WordDoc, WordApp, OutApp, OutMail As Object Dim WordContent As Word.Range Dim r As Range, RNG As Range Dim DocLoc As String Dim CustCol As Integer Dim wordFilename As String, pdfFilename As String, FileTypeOption As String, OutputOption As String Set wsAdd = Sheets("Adressen def") Set wsTemp = Sheets("Templates") DocLoc = wsTemp.Range("B" & wsAdd.Range("B3").Value).Value 'Word document naam '//------ Ensure a Template is selected If wsAdd.Range("B3").Value = Empty Then MsgBox "Please select a correct template from the drop down list" wsAdd.Range("D1").Select Exit Sub End If '//------ Create a Unique list of Manager Names lr = wsAdd.Range("D" & Rows.Count).End(xlUp).Row arrManager = wsAdd.Range("W6:W" & lr) On Error Resume Next For Each a In arrManager arrManagerUnique.Add a, a Next a '//------ Identify the Team Members that report to each manager Set RNG = wsAdd.Range("D6:D" & lr) For i = 1 To arrManagerUnique.Count '//------ Create Outlook object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.Createitem(0) '//------ Create Word object Set WordApp = GetObject("Word.Application") If Err.Number <> 0 Then Err.Clear 'Nieuw Word sessie starten Set WordApp = CreateObject("Word.Application") WordApp.Visible = True 'Maakt Word zichtbaar voor gebruiker End If '//------ Define Email and Output Options FileTypeOption = wsAdd.Range("G1").Value OutputOption = wsAdd.Range("G2").Value For Each r In RNG If wsAdd.Range("W" & r.Row).Value = arrManagerUnique(i) And wsAdd.Range("AB" & r.Row).Value = wsAdd.Range("D1").Value Then '//------ Create Word Document Set WordDoc = WordApp.Documents.Open(FileName:=DocLoc, ReadOnly:=False) 'Open de template For CustCol = 3 To 20 TagName = wsAdd.Cells(5, CustCol).Value 'Je geeft de rijnummer op waarin de tags staan vermeld TagValue = wsAdd.Cells(r.Row, CustCol).Value ' Tag waarde With WordDoc.Content.Find .Text = TagName .Replacement.Text = TagValue .Wrap = wdFindContinue .Execute Replace:=wdReplaceAll 'Forward:=True, Wrap:=wdFindContinue End With Next CustCol '//------ Create Word/PDF Document depending on Dropdown wordFilename = ThisWorkbook.Path & "\temp\" & wsAdd.Range("C" & r.Row).Value & " " & wsAdd.Range("F" & r.Row).Value & " " & wsAdd.Range("G" & r.Row).Value & " " & wsAdd.Range("H" & r.Row).Value & " - " & wsAdd.Range("U" & r.Row).Value & ".docx" pdfFilename = ThisWorkbook.Path & "\temp\" & wsAdd.Range("C" & r.Row).Value & " " & wsAdd.Range("F" & r.Row).Value & " " & wsAdd.Range("G" & r.Row).Value & " " & wsAdd.Range("H" & r.Row).Value & " - " & wsAdd.Range("U" & r.Row).Value & ".pdf" If FileTypeOption = "Word" Then WordDoc.SaveAs wordFilename If OutputOption = "Print" Or OutputOption = "Email/Print" Then WordDoc.PrintOut ElseIf FileTypeOption = "PDF/Word" Then WordDoc.SaveAs wordFilename WordDoc.ExportAsFixedFormat OutputFileName:=pdfFilename, ExportFormat:=wdExportFormatPDF If OutputOption = "Print" Or OutputOption = "Email/Print" Then WordDoc.PrintOut WordDoc.Close False Else WordDoc.ExportAsFixedFormat OutputFileName:=pdfFilename, ExportFormat:=wdExportFormatPDF If OutputOption = "Print" Or OutputOption = "Email/Print" Then WordDoc.PrintOut WordDoc.Close False End If '//------ Create Email and add Attachments If OutputOption = "Email" Or "Email/Print" Then With OutMail .Display .To = wsAdd.Range("W" & r.Row).Value .CC = wsAdd.Range("X" & r.Row).Value & ";" & wsAdd.Range("Y" & r.Row).Value .Subject = "Bonus letter(s) of your team" .Body = "Dear " & wsAdd.Range("D" & r.Row).Value & " , attached you will find the bonus letter(s) for your team. Please ensure they receive this letter individually within 1 week after receiving this e-mail." If FileTypeOption = "Word" Then .Attachments.Add wordFilename If FileTypeOption = "PDF" Then .Attachments.Add pdfFilename If FileTypeOption = "PDF/Word" Then .Attachments.Add wordFilename .Attachments.Add pdfFilename End If End With End If End If Next r 'OutMail.send Next i End Sub Things I have left to do: Add time stamp in column AA, and record template used in column Z I can't test the print commands as I dont have a printer Need some code to delete the 'temp' files once they are used Probably need some code to close the WORD/Outlook applications after use Can you test the Outmail.Send line works correctly? Tidy up of variables & code Let me know any feedback you have Many Thanks Caleeco
  17. Hi Caleeco, The body of the email will be changed later, so for the time being please hold column D as an example name reference. I will expand the columns later with more data and then the body will be set up correctly. So at this point no changes have to be made in that regard. It has to be dependendent on the choises in g1 en g2. Mainly it will be email pdf but it can occur that I have to print them and send them by regular mail. And the Word/pdf choise also is a must. Thanks again Caleeco Sapron
  18. Hi Sapron, Sorry more follow up questions: Who are the names listed in column D? are they the names of staff? Because the code you sent me suggests they are the names of the managers. (.Body = "Dear " & Blad16.Range("D" & CustRow).Value). What are we doing with cells G1 and G2? Do you always want PDFs emailed? or do you want it dependent on the dropdowns you've setup. so one of the 5 outcomes: print, print/email PDF, print/Email Word, email PDF, email word. Let me know Thanks Caleeco
  19. Hi Caleeco, That's exactly the goal ! And important is the columns "Templated used" and "Document sent" which have to be filled automatically after an email has been created, so I know what and when the email was created and no double email can be sent. But that's already in my code . Thanks a lot !!! Looking forward to it !!!! Sapron
  20. Hi Sapron, This is going to be a tough cookie to crack! Before I invest time programming. Can we just clarify the requirements. User selects template to be used in Cell D1 Program creates a unique list of MANAGER email addresses For each MANAGER, the code will create a PDF for ONLY the staff members who belong to that manager AND have the same template as selected in Cell D1 Attach all created PDFs for said manager AND copy in Manager of Manager & HR Manager So for the example above. Only 2 emails will be created: Email 1 To: Manager of 4 to [email protected] cc: Manager of Manager of 4 to [email protected], HR [email protected] Attachments: MIS OTHER-1 (Jos), MIS OTHER-2 (John) Email 2 To: Manager of 8 to [email protected] cc: Manager of Manager of 8 to [email protected], HR [email protected] Attachments: MIS OTHER-1 (Paul) Could you please confirm the above, and I will solve it this week! Thanks Caleeco
  21. Caleeco

    SUM Multiple Section

    File is on it's way back to you
  22. LPowell911

    SUM Multiple Section

    File sent earlier today. Thank you in advance!
  23. Caleeco

    SUM Multiple Section

    Hello, ah that's a shame... it was working on the test sheet I had created Yes, please do. My email is [email protected] I look forward to receiving the file! Thanks Caleeco
  24. LPowell911

    SUM Multiple Section

    Unfortunately, it didn't work . The sheet looks the same. Just an FYI, I referenced the incorrect columns (forgot a couple from memory). I changed the code to reflect accordingly still with no result. Could I send you the test file so you can see a little more in detail?
  25. I think you are on the right track :-) Thanks so far and looking forward to see it running perfectly. If you have questions please let me know !
  26. Hi Caleeco, no the [email protected] emails are not being used. I should have deleted them, because the manager will get the emails. So for each teammember of the manager one email must be sent to that specific manager with multiple attachment (of only his teammembers). Sorry for the misunderstanding, so please don't look at the individual email addresses, but only the managers and their managers/HR managers (in cc.) So emails to column W addresses and cc to X and Y. Hope it is clear now :-) O, D1 is to select the template. We have several templates . To select the correct template, the letters will be made for only those who have that specific template.
  1. Load more activity
×