VBA to Copy a Group of Sheets to new file

B

Biz

Well-known Member
Joined
May 18, 2009
Messages
1,773
Office Version
  1. 2021
Platform
  1. Windows
Hi,

I have tried to make the vba try() to work<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
*It filters on Column L and created unique values Column Z.<o:p></o:p>
*I want to copy all worksheets that belong to Proj Owner to Workbook. For instance, Jim has two worksheets, Michael has 1 worksheet,<o:p></o:p>
Tony D has 16 worksheets and Biz 19 worksheets.<o:p></o:p>
*it tried create emails for every project owner.<o:p></o:p>
<o:p> </o:p>
Could you please help me to create a workbooks with sheets for only that Proj Owner?<o:p></o:p>
<o:p> </o:p>
I have tried but could not make it work. I have used UDF get all worksheets belonging Proj Owner which desired result of worksheets for Proj Mgr should get.<o:p></o:p>

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD>L</TD><TD>M</TD><TD>N</TD><TD>O</TD><TD>P</TD><TD>Q</TD><TD>R</TD><TD>S</TD><TD>T</TD><TD>U</TD><TD>V</TD><TD>W</TD></TR><TR style="HEIGHT: 20px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Email </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Proj Owner </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Company 1 </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Company 2 </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Company 3 </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Company 4 </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Company 5 </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">#N/A</TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Total </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold"></TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Sheet Totals </TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Variance </TD></TR><TR style="HEIGHT: 119px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD>Jim</TD><TD>Jim_381308</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right; COLOR: #ff0000">($12,681.21)</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right; COLOR: #ff0000">($12,681.21)</TD><TD></TD><TD style="TEXT-ALIGN: right; COLOR: #ff0000">($12,681.21)</TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD>Jim</TD><TD>Jim_381300</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$3,465.45 </TD><TD style="TEXT-ALIGN: right">$5,677.88 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$9,143.33 </TD><TD></TD><TD style="TEXT-ALIGN: right">$9,143.33 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD>Michael</TD><TD>Michael_381362</TD><TD style="TEXT-ALIGN: right">$3,977.93 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$25,753.13 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$29,731.06 </TD><TD></TD><TD style="TEXT-ALIGN: right">$29,731.06 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 136px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD>Tony D</TD><TD>Tony D_381362</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,524.98 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,524.98 </TD><TD></TD><TD style="TEXT-ALIGN: right">$2,524.98 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">6</TD><TD>Tony D</TD><TD>Tony D_381400</TD><TD style="TEXT-ALIGN: right">$14,486.10 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$14,486.10 </TD><TD></TD><TD style="TEXT-ALIGN: right">$14,486.10 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">7</TD><TD>Tony D</TD><TD>Tony D_381425</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,020.93 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,020.93 </TD><TD></TD><TD style="TEXT-ALIGN: right">$1,020.93 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">8</TD><TD>Tony D</TD><TD>Tony D_381454</TD><TD style="TEXT-ALIGN: right">$929.36 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$929.36 </TD><TD></TD><TD style="TEXT-ALIGN: right">$929.36 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">9</TD><TD>Tony D</TD><TD>Tony D_381481</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$147.32 </TD><TD style="TEXT-ALIGN: right">$9,727.73 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$9,875.05 </TD><TD></TD><TD style="TEXT-ALIGN: right">$9,875.05 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">10</TD><TD>Tony D</TD><TD>Tony D_387603</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$3,205.52 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$3,205.52 </TD><TD></TD><TD style="TEXT-ALIGN: right">$3,205.52 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">11</TD><TD>Tony D</TD><TD>Tony D_387608</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,564.58 </TD><TD style="TEXT-ALIGN: right">$224.57 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,789.15 </TD><TD></TD><TD style="TEXT-ALIGN: right">$2,789.15 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">12</TD><TD>Tony D</TD><TD>Tony D_387619</TD><TD style="TEXT-ALIGN: right">$139.40 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$139.40 </TD><TD></TD><TD style="TEXT-ALIGN: right">$139.40 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">13</TD><TD>Tony D</TD><TD>Tony D_387622</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$5,224.04 </TD><TD style="TEXT-ALIGN: right">$5,651.70 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$10,875.74 </TD><TD></TD><TD style="TEXT-ALIGN: right">$10,875.74 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">14</TD><TD>Tony D</TD><TD>Tony D_387631</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$12,623.79 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$12,623.79 </TD><TD></TD><TD style="TEXT-ALIGN: right">$12,623.79 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">15</TD><TD>Tony D</TD><TD>Tony D_387671</TD><TD style="TEXT-ALIGN: right">$4,486.64 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$4,486.64 </TD><TD></TD><TD style="TEXT-ALIGN: right">$4,486.64 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">16</TD><TD>Tony D</TD><TD>Tony D_387673</TD><TD style="TEXT-ALIGN: right">$11,401.60 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$11,401.60 </TD><TD></TD><TD style="TEXT-ALIGN: right">$11,401.60 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">17</TD><TD>Tony D</TD><TD>Tony D_387680</TD><TD style="TEXT-ALIGN: right">$70.09 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$70.09 </TD><TD></TD><TD style="TEXT-ALIGN: right">$70.09 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">18</TD><TD>Tony D</TD><TD>Tony D_387684</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$114.52 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$433.16 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$547.68 </TD><TD></TD><TD style="TEXT-ALIGN: right">$547.68 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">19</TD><TD>Tony D</TD><TD>Tony D_387690</TD><TD style="TEXT-ALIGN: right">$305.50 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$399.25 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$704.75 </TD><TD></TD><TD style="TEXT-ALIGN: right">$704.75 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">20</TD><TD>Tony D</TD><TD>Tony D_387691</TD><TD style="TEXT-ALIGN: right">$2,710.72 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$312.42 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$3,023.14 </TD><TD></TD><TD style="TEXT-ALIGN: right">$3,023.14 </TD><TD style="TEXT-ALIGN: right">- </TD></TR></TBODY></TABLE>

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD>

</TD><TD>L</TD><TD>M</TD><TD>N</TD><TD>O</TD><TD>P</TD><TD>Q</TD><TD>R</TD><TD>S</TD><TD>T</TD><TD>U</TD><TD>V</TD><TD>W</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">21</TD><TD>Biz</TD><TD>Biz_387699</TD><TD style="TEXT-ALIGN: right">$3,423.00 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$3,423.00 </TD><TD></TD><TD style="TEXT-ALIGN: right">$3,423.00 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">22</TD><TD>Biz</TD><TD>Biz_387702</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,145.09 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,145.09 </TD><TD></TD><TD style="TEXT-ALIGN: right">$1,145.09 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">23</TD><TD>Biz</TD><TD>Biz_387711</TD><TD style="TEXT-ALIGN: right">$1,068.76 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,068.76 </TD><TD></TD><TD style="TEXT-ALIGN: right">$1,068.76 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">24</TD><TD>Biz</TD><TD>Biz_381334</TD><TD style="TEXT-ALIGN: right">$130.33 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$130.33 </TD><TD></TD><TD style="TEXT-ALIGN: right">$130.33 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">25</TD><TD>Biz</TD><TD>Biz_387721</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$441.68 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$441.68 </TD><TD></TD><TD style="TEXT-ALIGN: right">$441.68 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">26</TD><TD>Biz</TD><TD>Biz_387727</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$992.11 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$992.11 </TD><TD></TD><TD style="TEXT-ALIGN: right">$992.11 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">27</TD><TD>Biz</TD><TD>Biz_387733</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$116.48 </TD><TD style="TEXT-ALIGN: right">$13,144.73 </TD><TD style="TEXT-ALIGN: right">$2,588.56 </TD><TD style="TEXT-ALIGN: right">$2,095.84 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$17,945.61 </TD><TD></TD><TD style="TEXT-ALIGN: right">$17,945.61 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">28</TD><TD>Biz</TD><TD>Biz_387746</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$27,422.48 </TD><TD style="TEXT-ALIGN: right">$1,321.78 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$28,744.26 </TD><TD></TD><TD style="TEXT-ALIGN: right">$28,744.26 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">29</TD><TD>Biz</TD><TD>Biz_387738</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD></TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">30</TD><TD>Biz</TD><TD>Biz_387739</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD></TD><TD style="TEXT-ALIGN: right">$24.05 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">31</TD><TD>Biz</TD><TD>Biz_387740</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$7,610.22 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$7,610.22 </TD><TD></TD><TD style="TEXT-ALIGN: right">$7,610.22 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">32</TD><TD>Biz</TD><TD>Biz_387743</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$988.39 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$155.33 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,143.72 </TD><TD></TD><TD style="TEXT-ALIGN: right">$1,143.72 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">33</TD><TD>Biz</TD><TD>Biz_387744</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,674.29 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$2,674.29 </TD><TD></TD><TD style="TEXT-ALIGN: right">$2,674.29 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">34</TD><TD>Biz</TD><TD>Biz_387745</TD><TD style="TEXT-ALIGN: right">$843.77 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$843.77 </TD><TD></TD><TD style="TEXT-ALIGN: right">$843.77 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">35</TD><TD>Biz</TD><TD>Biz_387748</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$803.25 </TD><TD style="TEXT-ALIGN: right">$217.31 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$1,020.56 </TD><TD></TD><TD style="TEXT-ALIGN: right">$1,020.56 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">36</TD><TD>Biz</TD><TD>Biz_387749</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$4,280.56 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$4,280.56 </TD><TD></TD><TD style="TEXT-ALIGN: right">$4,280.56 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">37</TD><TD>Biz</TD><TD>Biz_387790</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$11,139.06 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$11,139.06 </TD><TD></TD><TD style="TEXT-ALIGN: right">$11,139.06 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">38</TD><TD>Biz</TD><TD>Biz_387791</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$931.86 </TD><TD style="TEXT-ALIGN: right">$5,850.44 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$6,782.30 </TD><TD></TD><TD style="TEXT-ALIGN: right">$6,782.30 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">39</TD><TD>Biz</TD><TD>Biz_387792</TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$657.47 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$11,636.22 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$12,293.69 </TD><TD></TD><TD style="TEXT-ALIGN: right">$12,293.69 </TD><TD style="TEXT-ALIGN: right">- </TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">40</TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD><TD></TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">41</TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD><TD style="FONT-WEIGHT: bold"></TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">42</TD><TD></TD><TD>Total</TD><TD style="TEXT-ALIGN: right">$43,973.20 </TD><TD style="TEXT-ALIGN: right">$24,977.27 </TD><TD style="TEXT-ALIGN: right">$91,101.03 </TD><TD style="TEXT-ALIGN: right">$19,628.37 </TD><TD style="TEXT-ALIGN: right">$26,944.34 </TD><TD style="TEXT-ALIGN: right">- </TD><TD style="TEXT-ALIGN: right">$206,624.21 </TD><TD></TD><TD style="TEXT-ALIGN: right">$219,305.42 </TD><TD style="TEXT-ALIGN: right">- </TD></TR></TBODY></TABLE>
UniqueList

<TABLE style="BACKGROUND-COLOR: #ffffff; PADDING-LEFT: 2pt; PADDING-RIGHT: 2pt; FONT-FAMILY: Arial,Arial; FONT-SIZE: 10pt" border=1 cellSpacing=0 cellPadding=0><COLGROUP><COL style="WIDTH: 30px; FONT-WEIGHT: bold"><COL style="WIDTH: 64px"><COL style="WIDTH: 251px"></COLGROUP><TBODY><TR style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt; FONT-WEIGHT: bold"><TD></TD><TD>Z</TD><TD>AA</TD></TR><TR style="HEIGHT: 20px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">1</TD><TD style="BACKGROUND-COLOR: #3366ff; FONT-FAMILY: Calibri; COLOR: #ffff99; FONT-SIZE: 11pt; FONT-WEIGHT: bold">Email </TD><TD></TD></TR><TR style="HEIGHT: 119px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">2</TD><TD>Biz</TD><TD>Biz_387699, Biz_387702, Biz_387711, Biz_381334, Biz_387721, Biz_387727, Biz_387733, Biz_387746, Biz_387738, Biz_387739, Biz_387740, Biz_387743, Biz_387744, Biz_387745, Biz_387748, Biz_387749, Biz_387790, Biz_387791, Biz_387792</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">3</TD><TD>Jim</TD><TD>Jim_381308, Jim_381300</TD></TR><TR style="HEIGHT: 17px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">4</TD><TD>Michael</TD><TD>Michael_381362</TD></TR><TR style="HEIGHT: 136px"><TD style="TEXT-ALIGN: center; BACKGROUND-COLOR: #cacaca; FONT-SIZE: 8pt">5</TD><TD>Tony D</TD><TD>Tony D_381362, Tony D_381400, Tony D_381425, Tony D_381454, Tony D_381481, Tony D_387603, Tony D_387608, Tony D_387619, Tony D_387622, Tony D_387631, Tony D_387671, Tony D_387673, Tony D_387680, Tony D_387684, Tony D_387690, Tony D_387691</TD></TR></TBODY></TABLE>

Use UDF formula aa2 and copied down
=MultiLOOKUP(Z2,$L$2:$W$39,2)


Code: 
Sub Try()
Dim rcells As Range, loopRange As Range, DataRange As Range
Dim eLR As Long, lLR As Long
Dim FileExtStr As String
Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim sh As Worksheet
    Dim TheActiveWindow As Window
    Dim TempWindow As Window
    Dim i As Long, j As Long
    Dim sString As String
eLR = Range("L" & Rows.Count).End(xlUp).Row
lLR = Range("Z" & Rows.Count).End(xlUp).Row
'Unique list of Email people
    Range("L1:L" & eLR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "Z1"), Unique:=True
Set DataRange = Range("L1:W" & eLR)
Set loopRange = Range("Z1:Z" & lLR)
'Sort Uniue values A-Z
ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Add Key:=loopRange.Offset(1, 0), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("UniqueList").Sort
        .SetRange loopRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

'Loop through all items in Auto filter
j = 1
For Each rcells In loopRange.Offset(1, 0)
    ActiveSheet.Range(DataRange.Address).AutoFilter Field:=1, Criteria1:=rcells.Value
    
    On Error Resume Next
    DataRange.Offset(1, 1).Resize(eLR - 1, 1).SpecialCells(xlVisible).Select
    On Error GoTo 0
    
    Set Sourcewb = ActiveWorkbook
    'Copy the sheets to a new workbook
    'We add a temporary Window to avoid the Copy problem
    'if there is a List or Table in one of the sheets and
    'if the sheets are grouped
    With Sourcewb
        Set TheActiveWindow = ActiveWindow
        Set TempWindow = .NewWindow
        sString = Cells(1 + j, 27)
        sString = CStr(sString)
        .Sheets(Array(sString)).Copy
        '.Sheets(Array("ReadMe", "MailSheet(s)")).Copy
    End With
    'Close temporary Window
    TempWindow.Close
    Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
    '    'Change all cells in the worksheets to values if you want
    '    For Each sh In Destwb.Worksheets
    '        sh.Select
    '        With sh.UsedRange
    '            .Cells.Copy
    '            .Cells.PasteSpecial xlPasteValues
    '            .Cells(1).Select
    '        End With
    '        Application.CutCopyMode = False
    '        Destwb.Worksheets(1).Select
    '    Next sh
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Part of " & Sourcewb.Name _
                 & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For i = 1 To 3
            .SendMail "", _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next i
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    j = j + 1
 Next rcells
    
 
    
'Parent.ShowAllData
    
 'Release memory
    Set DataRange = Nothing
    Set loopRange = Nothing
    Set Sourcewb = Nothing
    Set TheActiveWindow = Nothing
    Set TempWindow = Nothing
    Set Destwb = Nothing
   
    
End Sub
Public Function MultiLOOKUP(lookup_value As Variant, table_array As Range, _
    col_index_num As Long) As Variant
 
    Application.Volatile (False)
    Dim Cell As Range
    Dim a, B
    a = ""
    MultiLOOKUP = CVErr(xlErrNA)
 
    Set table_array = Intersect(table_array, table_array.Parent.UsedRange)
    If table_array Is Nothing Then Exit Function
 
    For Each Cell In Union(table_array.Columns(1), table_array.Cells(1))
        If Cell = lookup_value Then
            If a <> "" Then
                a = a & ", " & Cell.Offset(0, col_index_num - 1)
            Else
           a = Cell.Offset(0, col_index_num - 1)
            End If
        End If
    Next Cell
        If a = "" Then MultiLOOKUP = ""
        MultiLOOKUP = a
 
    End Function

Your help would be greatly appreciated.

Biz
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Hi Guys,

I am managed to get code working.

Can you guys think of a way of streamline anymore?

Is it possible to make e-mail address appear on e-mail too on Outlook?

Code: 
Sub Try()
Dim rcells As Range, loopRange As Range, DataRange As Range
Dim eLR As Long, lLR As Long, i As Long
Dim aSheet As Worksheet
Dim aNewWorkbook As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim aVariable As String
'Speeding Up VBA Code
Application.ScreenUpdating = False 'Prevent screen flickering
'Application.Calculation = xlCalculationManual 'Preventing calculation
Application.DisplayAlerts = False 'Turn OFF alerts
Application.EnableEvents = False 'Prevent All Events
 
eLR = Range("L" & Rows.Count).End(xlUp).Row
lLR = Range("Z" & Rows.Count).End(xlUp).Row
'Unique list of Email people
    Range("L1:L" & eLR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "Z1"), Unique:=True
Set DataRange = Range("L1:W" & eLR)
Set loopRange = Range("Z1:Z" & lLR)
'Sort Uniue values A-Z
ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Add Key:=loopRange.Offset(1, 0), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("UniqueList").Sort
        .SetRange loopRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'Loop through all items in Auto filter
For Each rcells In loopRange.Offset(1, 0).Resize(loopRange.Rows.Count - 1, 1)
    ActiveSheet.Range(DataRange.Address).AutoFilter Field:=1, Criteria1:=rcells.Value
 
    On Error Resume Next
    DataRange.Offset(1, 1).Resize(eLR - 1, 1).SpecialCells(xlVisible).Select
    On Error GoTo 0
 
aVariable = rcells.Value
Set Sourcewb = ActiveWorkbook
Set aNewWorkbook = Workbooks.Add
'Copy Sheets belong to Project Manager
For Each aSheet In Sourcewb.Worksheets
    If InStr(aSheet.Name, aVariable) > 0 Then
        aSheet.Copy Before:=aNewWorkbook.Sheets(1)
    End If
Next
Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
 
    TempFilePath = Environ$("temp") & "\"
    TempFileName = aVariable & "s' Part of " & FileNameNoExt(Sourcewb.Name) _
                 & " " & "as at " & Format(Now, "dd-mmm-yy h-mm-ss")
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        For i = 1 To 3
            .SendMail "", _
                      "This is the Subject line"
            If Err.Number = 0 Then Exit For
        Next i
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    Kill TempFilePath & TempFileName & FileExtStr
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
Next rcells
 
'Remove Filter
If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
 
'Speeding Up VBA Code
Application.ScreenUpdating = True 'Prevent screen flickering
'Application.Calculation = xlAutomatic 'Preventing calculation
Application.DisplayAlerts = True 'Turn OFF alerts
Application.EnableEvents = True 'Prevent All Events
 
 
 'Release memory
    Set DataRange = Nothing
    Set loopRange = Nothing
    Set aNewWorkbook = Nothing
    Set Sourcewb = Nothing
    Set Destwb = Nothing
 
 
End Sub

Code: 
 'The following function returns the filename without the extension from the file's full path:
Function FileNameNoExt(strPath As String) As String
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function

Biz
 
Last edited:
Upvote 0
My revised code which creates e-mails in outlook

Code: 
Private Sub Email()
Dim rcells As Range, loopRange As Range, DataRange As Range
Dim eLR As Long, lLR As Long, i As Long
Dim aSheet As Worksheet
Dim aNewWorkbook As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim aVariable As String
Dim OutApp As Object
Dim OutMail As Object
'Speeding Up VBA Code
Application.ScreenUpdating = False 'Prevent screen flickering
Application.Calculation = xlCalculationManual 'Preventing calculation
Application.DisplayAlerts = False 'Turn OFF alerts
Application.EnableEvents = False 'Prevent All Events
Worksheets("UniqueList").Activate
eLR = Range("L" & Rows.Count).End(xlUp).Row

'Unique list of Email people
    Range("L1:L" & eLR).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
        "Z1"), Unique:=True
'Get Last Row for loop range
lLR = Range("Z" & Rows.Count).End(xlUp).Row
        
Set DataRange = Range("L1:W" & eLR)
Set loopRange = Range("Z1:Z" & lLR)

'Sort Uniue values A-Z
ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("UniqueList").Sort.SortFields.Add Key:=loopRange.Offset(1, 0), _
    SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("UniqueList").Sort
        .SetRange loopRange
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
'Loop through all items in Auto filter
For Each rcells In loopRange.Offset(1, 0).Resize(loopRange.Rows.Count - 1, 1)
    ActiveSheet.Range(DataRange.Address).AutoFilter Field:=1, Criteria1:=rcells.Value
    
    On Error Resume Next
    DataRange.Offset(1, 1).Resize(eLR - 1, 1).SpecialCells(xlVisible).Select
    On Error GoTo 0

aVariable = rcells.Value
Set Sourcewb = ActiveWorkbook
Set aNewWorkbook = Workbooks.Add
'Copy Sheets belong to Project Manager
For Each aSheet In Sourcewb.Worksheets
    If InStr(aSheet.Name, aVariable) > 0 Then
        aSheet.Copy Before:=aNewWorkbook.Sheets(1)
    End If
Next
Set Destwb = ActiveWorkbook
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With
    
    TempFilePath = Environ$("temp") & "\"
    TempFileName = aVariable & "s' Part of " & FileNameNoExt(Sourcewb.Name) _
                 & " " & "as at " & Format(Now, "dd-mmm-yy h-mm-ss")
    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
        
       Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
       Set OutMail = OutApp.CreateItem(0)
            With OutMail
                .To = rcells.Value
                '.cc = cell.Offset(0, 1).Value
                .Subject = "Sales"
                '.Body = "Dear " & cell.Offset(0, -1).Value
                .Display  'Or use Send
                .Attachments.Add TempFilePath & TempFileName & FileExtStr
         End With
        On Error GoTo 0
        .Close SaveChanges:=False
    End With
    Kill TempFilePath & TempFileName & FileExtStr
Next rcells
    
'Remove Filter
If ActiveSheet.AutoFilterMode Then ActiveSheet.ShowAllData
    
'Speeding Up VBA Code
Application.ScreenUpdating = True 'Prevent screen flickering
Application.Calculation = xlAutomatic 'Preventing calculation
Application.DisplayAlerts = True 'Turn OFF alerts
Application.EnableEvents = True 'Prevent All Events
    
    
 'Release memory
    Set DataRange = Nothing
    Set loopRange = Nothing
    Set aNewWorkbook = Nothing
    Set Sourcewb = Nothing
    Set Destwb = Nothing
    Set OutApp = Nothing
    Set OutMail = Nothing
    
End Sub

Code: 
 'The following function returns the filename without the extension from the file's full path:
Function FileNameNoExt(strPath As String) As String
    Dim strTemp As String
    strTemp = Mid$(strPath, InStrRev(strPath, "\") + 1)
    FileNameNoExt = Left$(strTemp, InStrRev(strTemp, ".") - 1)
End Function

Hope it helps someone with this similar problem
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
451
smozgur
smozgur
E
  • Question
VBA code clean up
Replies
9
Views
389
mumps
mumps
E
  • Question
Adding a custom message.
Replies
1
Views
606
Micron
M
C
  • Solved
Excel 2016 32bit VBA Pulling info from Website to Sheet
Replies
2
Views
1K
CrashOD
C
V
  • Question
Issue with scraping with VBA
Replies
1
Views
672
John_w
J

Forum statistics

Threads
1,221,564
Messages
6,160,513
Members
451,655
Latest member
rugubara

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top