copy range for each value in name range with a twist

bvanscoy678 · Oct 30, 2013

Hi,

I have a few ideas about this, but looking for a push in the right direction.
My workbook (redacted) contains a list of 10 people (hundreds in working copy) that I want to send their fitness results to. My main data worksheet is worksheet (1) and it list all of their results. Worksheet (2) is how I display and print the results. In the display results! E3, you will see a dynamic name range as my validation. All of the results on this page are simple lookup values based off of display results E3.

For each row in my data sheet, I want to display the results in my display results worksheet, then copy that worksheet and paste into an email. I will send the email based off of the email address in display results! J1.

I have an idea based on Ron Bruin's email macro, but not sure how to copy the range for each row, to work into his macro.

Thanks for any tips...Brent

Smallman · Oct 30, 2013

Hi Brent

Yeah this gear is doable. What you want to do is create a simple loop which cycles through the names in your data worksheet and drops each name into E3 of the Display sheet. Once this is done you can incorporate Ron's code. I have looked at Ron's code on a number of occasions and I think it can be vastly simplified. I will have a look at the problem shortly.

You have a lot of merged cells in the workbook. Look up Centre Across Selection. While XL gives you the capacity to Merge cells in practice it is best to avoid this and use the technique above. Once you start working with vb you will be so glad of the change and the look and feel is the same without the loss of fidelity.

Take care

Smallman

bvanscoy678 · Oct 30, 2013

Yeah, I merged cells when I shouldn't have. I created it last year and since then I did a few other smaller projects and found out what pain the rear merge cells are. I can change all the merged cell into center across selection if that will help?

thanks

Smallman · Oct 30, 2013

Brent

Just another observation - named ranges. If i have 6 in any given worksheet I start to get gittery. There are too many in your workbook in my opinion. Having 50 odd named ranges can be difficult to manage and for others to follow.

So here is a start.

Code:

Option Explicit
Sub Simpleo()
Dim i As Integer
    For i = 2 To Sheet1.Range("E" & Rows.Count).End(xlUp).Row
        Sheet2.[e3] = Sheet1.Range("E" & i) & "-#1"
        'email code right here.
    Next i
End Sub

Next I will have a look at your email code. Can surely simplify that puppy.

Take care

Smallman

Smallman · Oct 30, 2013

Brent

Yes anything that is merged on the Display Sheet you need to completly destroy. You need a clean sheet with no merged cells as we are going to copy each instance of the Display sheet to a new workbook, save that workbook and send it via email. Merged cells don't work without nasty work arounds.

Ta

Smallman

bvanscoy678 · Oct 31, 2013

Yeah, I went a bit crazy with name ranges. Truth is I started the project and ended up adding and adding until it got a bit our of control. I knew how to do it with formulas, but not VBA. I get the main sheet cleaned up first thing in the morning. I am trying to finish up my main project for my java class, so I can't make a go at it until tomorrow. I'll check back first thing. I'll add my email code also.

thanks!

bvanscoy678 · Oct 31, 2013

Good morning,

I fixed all the merge cells in my worksheet.

This is the code I have used recently to email a bunch of workbooks.

Code:

'''''Ron de Bruin Excel Automation
 
Sub CDO_Mail_Small_Text_2(wb As Workbook)
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
     
   
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
   
    Email = Worksheets(2).Cells(1, 10).Value
 
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
 
    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"
   
    wb.ChangeFileAccess xlReadOnly
   
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
       
        .AddAttachment wb.FullName
       
        .TextBody = strbody
        .Send
    End With
 
    'wb.ChangeFileAccess xlReadWrite
 
End Sub

Smallman · Oct 31, 2013

Hi Brent

Thanks for fixing the file. That was cool! It is almost 11 here down under. I will have a look at this in the morning. Good evening - we are at opposite ends of the earth no doubt.

Take it easy

Smallman

Smallman · Nov 1, 2013

Hi Brent

OK here is an update. I have not had a chance to look at Ron's code yet.

Code:

Option Explicit
Sub Simpleo()
Dim i As Integer
Dim owb As Workbook
Dim ws As Worksheet
Set ws = Sheet2
 
    For i = 2 To Sheet1.Range("E" & Rows.Count).End(xlUp).Row
        Sheet2.[e3] = Sheet1.Range("E" & i) & "-#1"
        Set owb = Workbooks.Add
        ws.Columns("A:H").Copy [a1]
        owb.SaveAs "D:\" & [e3] & ".xls"
        'Email Code here
        owb.Close False
  Next i
End Sub

Take care

Smallman

bvanscoy678 · Nov 1, 2013

Hi,

I have played with this a bit off and on all day, but can't work Ron's code into it. I ran a test and it works perfect to create the workbook (I changed to the C:drive/folder), but each time I changed a few things in Ron's code, I don't have my variables correct. I'll keep at it. Thanks for the help!

bvanscoy678 · Nov 1, 2013

Another round at it.

I tried a different approach, but it did not work. I ran your code to create the workbooks, then I adapted code I used to email every workbook in a folder, but I struck out on 2 things.

First of all I got an error message on this line:

Code:

 .Attachments.Add ActiveWorkbook.FullName

But, even before that I got an update links warning and my new workbook only had references, but no values. That probably because in your code we did not copy and paste values. I will have to read up on the [ ] in your code to see what they mean.

I'll try another way!

Code:

Sub Test()
 
'''''''Original Post from EE search
Dim myDir As String
 
    myDir = "C:\TEST Fitness Results"
    MyFile = Dir(myDir & "\*.xl*")
 
    Do While MyFile <> ""
        Workbooks.Open myDir & "\" & MyFile
             
            Call CDO_Mail_Small_Text_2
     
        ActiveWorkbook.Close True
       
       
        MyFile = Dir
    Loop
   
    End Sub
   
''''''''''''' Original File from http://www.rondebruin.nl/win/s1/cdo.htm
''''''''''''' Support paid to Ron's site
'If you have a GMail account then you can try this example to use the GMail smtp server
'The example will send a small text message
'You must change four code lines before you can test the code
 
'.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Full GMail mail address"
'.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "GMail password"
 
'Use your own mail address to test the code in this line
'.To = "Mail address receiver"
 
'Change YourName to the From name you want to use
'.From = """YourName"" <Reply@something.nl>"
 
'If you get this error : The transport failed to connect to the server
'then try to change the SMTP port from 25 to 465
 
Sub CDO_Mail_Small_Text_2()
    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim Flds As Variant
    Dim Email As String
     
    Dim wb As Workbook
   
 
     
   
    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
    Set wb = ActiveWorkbook
   
    wb.Save
   
    Email = Worksheets(1).Cells(1, 17).Value
 
    iConf.Load -1    ' CDO Source Defaults
    Set Flds = iConf.Fields
    With Flds
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "bvanscoy678@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "XXXXXXX"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
 
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
        .Update
    End With
 
    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"
 
    With iMsg
        Set .Configuration = iConf
        .To = Email
        .CC = ""
        .BCC = ""
        ' Note: The reply address is not working if you use this Gmail example
        ' It will use your Gmail address automatic. But you can add this line
        ' to change the reply address  .ReplyTo = "Reply@something.nl"
        .From = """Brent"" <bvanscoy678@gmail.com>"
        .Subject = "Important message"
        .Attachments.Add ActiveWorkbook.FullName
        .TextBody = strbody
        .Send
    End With
 
End Sub

Smallman · Nov 1, 2013

Hey Brent

It is all good we will get you over the line. I did this a couple of years ago using Outlook. I am at home now and won't be able to test the code on an Outlook machine till I get into the office on Monday. I have however helped others solve this problem in the past. Here is the code I used to email a workbook.

Code:

Sub Mailwb()
    Dim wb As Workbook
 On error resume next
    Set wb = ActiveWorkbook
        wb.SendMail "YourEMAIL@Here.com.au", "Subject line"
        If Err.Number = 0 Then Exit sub
    On Error GoTo 0
End Sub

I remember starting with Ron's code and just ripping it down to the above. You can see how one of my post unfolded here;

http://www.ozgrid.com/forum/showthread.php?t=171213&highlight=smallman ron outlook email

It is exactly the same as what you are trying to do. I would suggest you start simple and then we can adapt the above for your needs. As a starter you will need the email addresses from the file to be incorporated line by line in the above with a variable rather than your email here etc.

Anyways Brent I am off for my morning java!!!

Take care

Smallman

bvanscoy678 · Nov 2, 2013

I will take a look at this tomorrow. I have outlook on my home machine. I'll run a few test and see how it goes. Thanks for the patience and time. Talk to you on Monday.

Thanks, Brent

copy range for each value in name range with a twist

bvanscoy678

Member

Attachments

Smallman

Excel Ninja

bvanscoy678

Member

Smallman

Excel Ninja

Smallman

Excel Ninja

bvanscoy678

Member

bvanscoy678

Member

Attachments

Smallman

Excel Ninja

Smallman

Excel Ninja

bvanscoy678

Member

bvanscoy678

Member

Smallman

Excel Ninja

bvanscoy678

Member