Solved

Excel Macro to fill out two templates

Posted on 2009-04-14
21
714 Views
Last Modified: 2012-05-06
Hello,
An existing macro works well,it
I open up a excel file
The macro, opens a template , copies the required cells from the old spreadsheet, closes the old , opens a template, and copies the cells to the template. In the new spreadsheet, it also check to see what currency the spreadsheet is in and puts in different variables based upon the cuurency type, either CAD or USD. Then it prints and emails the file. Now I need to adjust it becuase I need it to open and populate another spreadsheet with the same data.  The other template is laid out differently with less columns and a formula to calcute a fee based upon the data from the old spreadsheet. The newer tempalte will be printed then emailed, then the older template will just be emailed. I thought if I just add in the new items it would work but can't fill in the variables.  

Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for 
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total, T_Clients, T_Alloc
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    
    FileName = InputBox("Enter Original File Name")
    
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
    'this is the new template'
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    
    'copy required cells from original file'
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
        End With
    wb1.Close
   'Fill out the new template and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 End With
    'Determine USD and CAD and fill out resepective areas'
Set wb2 = ActiveSheet
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
    Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
    End If
    End With
  'Fill out the older template and send
     With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
        End With
    'Determine USD and CAD and fill out resepective areas'
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
    Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
    End If
 
 'print the newer template and save it
 Set wb2 = ActiveSheet
 wb2.PageSetup.Orientation = xlLandscape
 wb2.PageSetup.PaperSize = xlPaperLetter
 wb2.PageSetup.FitToPagesWide = 1
 wb2.PageSetup.FitToPagesTall = 1
 
ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
 
wb2.SaveAs ("C:\Documents and Settings\rsernowski\Documents\" & FileName & ".xls")
 
 
If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
  Set OutApp = CreateObject("Outlook.Application")
 OutApp.Session.Logon
 Set OutMail = OutApp.CreateItem(0)
 With wb2
   With OutMail
  .To = ""
  .CC = "rsernowski@gmail.com"
  .BCC = ""
 .Subject = ""
 .Body = ""
 .Attachments.Add wb2.FullName
 .Send   'or use .Display
 End With
 On Error GoTo 0
 wb2.Close SaveChanges:=False
 End With
 
 'send the document the older template
 Set wb3 = ActiveSheet
 If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
 Set OutApp = CreateObject("Outlook.Application")
 OutApp.Session.Logon
 Set OutMail = OutApp.CreateItem(0)
 With wb3
    With OutMail
       .To = "mymailplace.ca"
              .CC = "rsernowski@gmail.com"
              .BCC = ""
            .Subject = ""
             .Body = ""
            .Attachments.Add wb3.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
       wb3.Close SaveChanges:=False
     End With
  End Sub

Open in new window

0
Comment
Question by:rsernowski
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 11
  • 10
21 Comments
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24158623
Hi Robert,

1. Can you explain a bit more what you mean with:
 "I thought if I just add in the new items it would work but can't fill in the variables."

2. You are changing the wb3 workbook variable at line 118 with "Set wb3 = ActiveSheet" This doesn't make sense to me. What are you trying to achieve with this line?

3. Can you describe what result you expected from your updated macro and what result you get.

Cheers,
Curt
0
 

Author Comment

by:rsernowski
ID: 24161619
Hi Curt,

I am working thru the code right now again.The set WB3 active was a trail.  In a nutshell, I have a imported file.(we call it orginal. It copies the data, close the original file, fills it out, prints it, then probably send it, then I guess close the wb2 , then fill out wb3 with the same data, then send it.
0
 

Author Comment

by:rsernowski
ID: 24161800
Ok I adjust the code a bit.  So really it is supposed to fill out the first template , then fill out the second one.  No sending or printing yet. It fills out wb3 correctly but doesn't fill out wb2 correctly, missing the if cell = USD then..
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24163639
You have the End With in the wrong places and you haven't got the full stop in front of the currency cells.

See snippet

Curt
    'Fill out the new template and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
        'Determine USD and CAD and fill out resepective areas'
        Set wb2 = ActiveSheet
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'Fill out the older template and send
    With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24166750
Hi Curt ,

Ok it is working much better now, thanks One last question if you please, it is all working fairly good now.  But the macro is supposed to print it on letter landscape , fit to 1 page , but I get portrait, on 3 pages! Any help would be appreciated.

Thanks
Robert

Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for Citi and NBCN
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
   
    FileName = InputBox("Enter Original File Name")
   
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
   
    'Copy the orginal file
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
   'Fill out CITI Trade Advice and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 17) = S_Name
        .Cells(4, 18) = S_Number
        .Cells(4, 19) = T_Shares
        .Cells(4, 20) = T_Price
        .Cells(4, 23) = T_Total
        .Cells(4, 24) = T_DTC
    End With
    'Determine USD and CAD and fill out resepective areas'
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
        Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
    End If
    'Save and Print
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8
    wb2.PrintOut
    'need to send the file
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
               '.To = "cfsc.bpofa2@citi.com"
                .CC = "rsernowski@gmail.com
                .BCC = ""
                .Subject = "Trade-Newport Cdn Equity Fund -CITI"
                .Body = "Attached are Bluewater trade allocatons in excel"
                .Attachments.Add wb2.FullName
                .Send   'or use .Display
        End With
        On Error GoTo 0
    wb2.Close
    End With
 
    'Fill out NBCN Trade Advice print and send
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    With wb3.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
    End With
    'Determine USD and CAD and fill out resepective areas'
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
        Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
   End If
  'send the document to NBCN
   If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
   Set OutApp = CreateObject("Outlook.Application")
   OutApp.Session.Logon
   Set OutMail = OutApp.CreateItem(0)
   With wb3
        With OutMail
      '     .To = "ftpdepot@nbf.ca"
            .CC = "rsernowski@bluewaterinvestment.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
   End With
   End Sub
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24168007
Try this one.

Cheers,
Curt
Sub newport_trades1()
'
' newport_trades Macro
' Generate and send trade tickets for
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total, T_Clients, T_Alloc
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    FileName = InputBox("Enter Original File Name")
 
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
    'this is the new template'
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
 
    'copy required cells from original file'
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
    'Fill out the new template and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
        'Determine USD and CAD and fill out resepective areas'
        Set wb2 = ActiveSheet
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'Fill out the older template and send
    With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'print the newer template and save it
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    ActiveWindow.SelectedSheets.PrintPreview
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
 
    wb2.SaveAs ("C:\Documents and Settings\rsernowski\Documents\" & FileName & ".xls")
 
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
            .To = ""
            .CC = "rsernowski@gmail.com"
            .BCC = ""
            .Subject = ""
            .Body = ""
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb2.Close SaveChanges:=False
    End With
 
    'send the document the older template
    wb3.Activate
    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb3
        With OutMail
            .To = "mymailplace.ca"
            .CC = "rsernowski@gmail.com"
            .BCC = ""
            .Subject = ""
            .Body = ""
            .Attachments.Add wb3.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
    End With
End Sub
Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for Citi and NBCN
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    FileName = InputBox("Enter Original File Name")
 
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
 
    'Copy the orginal file
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
    'Fill out CITI Trade Advice and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 17) = S_Name
        .Cells(4, 18) = S_Number
        .Cells(4, 19) = T_Shares
        .Cells(4, 20) = T_Price
        .Cells(4, 23) = T_Total
        .Cells(4, 24) = T_DTC
        'Determine USD and CAD and fill out resepective areas'
        Set wb2 = ActiveSheet
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8
    'need to send the file
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
            '.To = "cfsc.bpofa2@citi.com"
            .CC = "rsernowski@gmail.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund -CITI"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb2.Close
    End With
 
    'Fill out NBCN Trade Advice print and send
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'send the document to NBCN
    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb3
        With OutMail
            '     .To = "ftpdepot@nbf.ca"
            .CC = "rsernowski@bluewaterinvestment.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
    End With
End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24272726
Hi Curt

Sorry for the dealy on this. I am gettign an error on this line/:
 Set wb2 = ActiveSheet
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24275110
Hi Robert,

That line was in the first code you submitted and I just left it in the code. Try to delete that line, it shouldn't be there.

Curt

0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24275896
My last code snippet had 2 macros. It should only be one.

Try this one.

Curt

Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for Citi and NBCN
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    FileName = InputBox("Enter Original File Name")
 
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
 
    'Copy the orginal file
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
    'Fill out CITI Trade Advice and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 17) = S_Name
        .Cells(4, 18) = S_Number
        .Cells(4, 19) = T_Shares
        .Cells(4, 20) = T_Price
        .Cells(4, 23) = T_Total
        .Cells(4, 24) = T_DTC
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8
    'need to send the file
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
            '.To = "cfsc.bpofa2@citi.com"
            .CC = "rsernowski@gmail.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund -CITI"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb2.Close
    End With
 
    'Fill out NBCN Trade Advice print and send
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'send the document to NBCN
    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb3
        With OutMail
            '     .To = "ftpdepot@nbf.ca"
            .CC = "rsernowski@bluewaterinvestment.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
    End With
End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24281057
Hey Curt

Almost got it! IO am getting an error on this line:
.Attachments.Add wb3.FullName (I changed it from wb2 to wb3).  The error is file not found.
Any thoughts?
Regards
robert
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24286515
Try this.

Curt
Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for Citi and NBCN
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
 
    FileName = InputBox("Enter Original File Name")
 
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
 
    'Copy the orginal file
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
    'Fill out CITI Trade Advice and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 17) = S_Name
        .Cells(4, 18) = S_Number
        .Cells(4, 19) = T_Shares
        .Cells(4, 20) = T_Price
        .Cells(4, 23) = T_Total
        .Cells(4, 24) = T_DTC
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8
    'need to send the file
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
            '.To = "cfsc.bpofa2@citi.com"
            .CC = "rsernowski@gmail.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund -CITI"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb2.Close
    End With
 
    'Fill out NBCN Trade Advice print and send
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    With wb3.Worksheets("Sheet1")
        .Cells(3, 5) = T_Buy
        .Cells(3, 8) = T_Date
        .Cells(3, 9) = S_Date
        .Cells(3, 14) = T_Curr
        .Cells(3, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
 
        'Determine USD and CAD and fill out resepective areas'
        If T_Curr = "CAD" Then
            .Cells(4, 1) = "297Z01A"
            .Cells(4, 3) = "29701BC"
            .Cells(4, 4) = "TU"
        Else
            .Cells(4, 1) = "297Z01B"
            .Cells(4, 3) = "29701BD"
            .Cells(4, 4) = "NU"
        End If
    End With
    'send the document to NBCN
    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
        With OutMail
            '     .To = "ftpdepot@nbf.ca"
            .CC = "rsernowski@bluewaterinvestment.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb3.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24305286
Hi Curt ,
I am getting the same error on this line:
.Attachments.Add wb3.FullName
"cannot find this file. Verfiy the path and file name are correct.
Thanks for your help
Robert
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24310811
Hi Robert,
The first macro seems to be nearly ok. I think it's a matter of where you keep the macro. You need to have the macro in a separate file and not in one of the files you manipulate and close (wb1, wb2, wb3). You also need to save wb3 to get the file with the new values.

 .Attachments.Add wb3.FullName will send wb3 as it is before you add the new values. I suggest you use the same temporary save as is used in Ron DeBruin's sample,  which I assume you based your email sending on, before you send wb3.

Try to use the macro by pressing the button in the attached file. This is the macro as you had it at the beginning of your question.

You will need to add a save of wb3 if you want the updated file to be sent.

Regards,
Curt
Control.xls
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24310883
Hi Robert,

This version will save wb3 in the same way you save wb2 before sending it.

Regards,
Curt
Control-2.xls
0
 

Author Comment

by:rsernowski
ID: 24329359
Hi Curt,

I have keep all the macros on personal.xls . Perhaps it doesn't like that wb2 is saved with the same file name.?
Ideas?
Thanks
Robert
0
 

Author Comment

by:rsernowski
ID: 24329593
Hi Curt,

Sorry that is exactly as you have suggested.  I will work on saving with a different name: So I need something like NBCN+ the original file name?
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24348694
Hi Robert,

You can use any name you like to save the file. If you don't want to keep a copy of the updated file you can delete it with the "Kill" command before you exit the sub.

Curt
0
 

Author Comment

by:rsernowski
ID: 24358156
Hi Curt
I got it ! Thanks for your help. One last question.  I can't get it to print correctly or save in an older version of excel! I use excel 2007 and so is my template in 2007. I need to save the file as older version. Here is my code to print and save:

'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut
    wb2.SaveAs ("\\BWDC\Common\Trade_tickets\Newport\CITI-" & FileName & ".xls")

When I try to open the saved file I get "The file you are tryimg to open is in a different format...."It opens but ...

The printing code, just prints in portrait and doesn't fit to 1 page!
Yep I am now saving to the server.
Any help would be appreciated
Thanks
Robert
   
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24364868
Hi Robert,

The macro in the attached Control-3.xls file is saving both wb2 and wb3 in Excel 2003 format. The printing in this macro does also work correctly. This is the same file as I uploaded previously with the difference that the button works properly in this version.

You need the xlExcel8 parameter at the end of your "SaveAs" line to save as Excel 2003 like this:
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8

Try by pressing the button in the attached file.

Regards,
Curt

Control-3.xls
0
 
LVL 18

Accepted Solution

by:
Curt Lindstrom earned 500 total points
ID: 24365237
Hi Robert,

I just noticed that 1 line was missing in the code which is need to change the page setup to 1 page wide and 1 page tall. The code should be:

    'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut

This is corrected in the attached sample file

Regards,
Curt
Control-4.xls
0
 

Author Closing Comment

by:rsernowski
ID: 31570077
Thanks for all your Help Curt! Really appreciate your time
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are …
In Part II of this series, I will discuss how to identify all open instances of Excel and enumerate the workbooks, spreadsheets, and named ranges within each of those instances.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

739 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question