Go Premium for a chance to win a PS4. Enter to Win


Part 8 to: Import more data into spreadsheet

Posted on 2013-06-14
Medium Priority
Last Modified: 2013-06-17
Continuing on from: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_28156647.html

Now that an email is created when a value is inserted into Col N (with a value in Col K) I need this function to also do the following:

1. Open spreadsheet Blank - New Card Load.xls (example posted - its path is:
C:\Users\Michael\Dropbox\Sovereign\MasterCard\MasterCardLoadRequests/Blank - New Card Load.xls)

2. In Col D of Blank - New Card Load.xls post the value from Col T of Applicant Status

3. In Col H of Blank - New Card Load.xls post the value from Col B from Applicant Status

4. In Col i of Blank - New Card Load.xls post the value from Col C from Applicant Status

5. Save Blank - New Card Load.xls as 'First Name Last Name - New Card Load.xls' to the same location Blank - New Card Load.xls came from
- example save as: Joe Smith - New Card Load.xls

6. And attach it with the other attachments to the email created

(My concern with these functions is what happens when multiple records are in an emailed xls spreadsheet, but guess we'll cross that bridge later.)

If too much for one question, let me know.

Thank you, gowflow!

Question by:JaseSt
  • 5
  • 3
LVL 31

Accepted Solution

gowflow earned 2000 total points
ID: 39248975
ok here it is:

1) Make a copy of your latest file and give it a new name
2) Goto VBA and doublclick on Module1 and delete all the code that is there.
3) Copy and Paste the below code in Module1

Sub SendEmail(Rng As Range, fName As String)
Dim WB As Workbook
Dim WS As Worksheet

Dim SendTo As String
Dim Blindcc As String
Dim OutlookApp As Object
Dim MItem As Object
Dim subject_ As String
Dim attach_ As String
Dim fFile
Dim omail As Outlook.MailItem

Application.DisplayAlerts = False

'Create Outlook
Set OutlookApp = CreateObject("Outlook.Application")

'Fill in Subject Details'
subject_ = "New Mastercard Application for (" & Rng.Cells(1, "B") & " " & Rng.Cells(1, "C") & ")"
SendTo = "nmai@banking.bz"
Blindcc = "david@offshorelawcenter.com"

'Create the Email
Set MItem = OutlookApp.CreateItem(0)
With MItem
  .To = SendTo
  .BCC = Blindcc
  .Subject = subject_
  '---> Attach files
  For Each fFile In Rng.SpecialCells(xlCellTypeFormulas)
        If InStr(1, fFile.Formula, "HYPERLINK") <> 0 Then
            fpos = InStr(1, fFile.Formula, "HYPERLINK") + 11
            attach_ = Mid(fFile.Formula, fpos, InStr(fpos, fFile.Formula, Chr(34)) - fpos)
            .Attachments.Add (attach_)
        End If
  Next fFile
  .Attachments.Add (fName)
  .Body = "Hi Nalleli," & Chr(10) & Chr(10) _
    & "Attached are the documents and load request for (" & Rng.Cells(1, "B") & " " & Rng.Cells(1, "C") & ")" & Chr(10) _
    & "Please have his card shipped to address indicated on spreadsheet." & Chr(10) _
    & "PIC:99554Freedom" & Chr(10) & Chr(10) _
    & "Please let me know you received this email." & Chr(10) & Chr(10) _
    & "Thank you." & Chr(10) & Chr(10) _
    & "Michael" & Chr(10) _
    & "Sovereign Gold Card Support" & Chr(10) _
    & "www.sovereigngoldcard.com"

  'Send the Email
End With

'Clear Resources
Set MItem = Nothing
Set OutlookApp = Nothing

Application.DisplayAlerts = True
End Sub

Function CreateNewCardLoad(Rng As Range) As String
Dim sPathName As String
Dim sFileName As String
Dim sBlankCardLoad As String
Dim MaxRow As Long
Dim WS As Worksheet
Dim WB As Workbook

sBlankCardLoad = "C:\Users\Michael\Dropbox\Sovereign\MasterCard\MasterCardLoadRequests\Blank - New Card Load.xls"
sPathName = "C:\Users\Michael\Dropbox\Sovereign\MasterCard\MasterCardLoadRequests\"

'sBlankCardLoad = ActiveWorkbook.Path & "\Blank - New Card Load.xls"
'sPathName = ActiveWorkbook.Path & "\"

Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Set WB = Workbooks.Open(Filename:=sBlankCardLoad)
Set WS = ActiveSheet
MaxRow = WS.UsedRange.Rows.Count + 1

sFileName = sPathName & Rng.Cells(1, "B") & " " & Rng.Cells(1, "C") & " - New Card Load.xls"

'---> Affect Values to Card Load.xls
WS.Range("D" & MaxRow) = Rng.Cells(1, "T")
WS.Range("H" & MaxRow) = Rng.Cells(1, "B")
WS.Range("I" & MaxRow) = Rng.Cells(1, "C")
WB.SaveAs Filename:=sFileName
CreateNewCardLoad = sFileName
WB.Close savechanges:=True

'---> Clean Variables
Set WB = Nothing
Set WS = Nothing

Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Function

Open in new window

4) SAVE the workbook
5) doubleclick on Sheet1 in the Left pane and select Worksheet Change Event and delete all the code that is between Private Sub Worksheet_Change and End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

>> Delete all the Code that is Here <<

End Sub

6) Copy and Paste the below code after
Private Sub Worksheet_Change(ByVal Target As Range)

Dim cCell As Range
Dim fName As String

For Each cCell In Target
    If (Not Intersect(cCell, Columns("O")) Is Nothing Or _
        Not Intersect(cCell, Columns("P")) Is Nothing Or _
        Not Intersect(cCell, Columns("Q")) Is Nothing Or _
        Not Intersect(cCell, Columns("R")) Is Nothing Or _
        Not Intersect(cCell, Columns("S")) Is Nothing) _
        And LCase(cCell.Value) = "x" Then
        cCell = Format(Now, "mm/dd/yyyy")
    End If
Next cCell

'---> Send Email if Cell in Col N has a value and Cell in Col K
If Range("N" & Target.Row) <> "" And _
    Range("K" & Target.Row) <> "" Then
    If MsgBox("Send Mail for " & Cells(Target.Row, "C") & ", " & Cells(Target.Row, "B") & " ?", vbQuestion + vbYesNo, "Send Email") = vbYes Then
        fName = CreateNewCardLoad(Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")))
        SendEmail Range(Cells(Target.Row, "A"), Cells(Target.Row, "T")), fName
    End If
End If

Open in new window

7) SAVE and Exit the workbook
8) Your blank load file should be named exactly as you mentioned in your post which is:
Blank - New Card Load.xls
and not as the file you posted in here that is

9) the file you posted had data on row 2 and some deleted row until row 35 you need to have this file completely clean like you need to delete all rows from Row 2 to Row 1000 to make sure it is completely clean.

Give it a try and let me know.

Author Comment

ID: 39249023
it did everything perfectly except the data was not imported correctly to the renamed Blank - New Card Load sheet. Please see attached.

And I did delete everything from row 2 down for about 50 rows just to make sure. I cleared content and deleted the rows, but still came up with the attached.

saved blank sheet

Author Comment

ID: 39249027
as you can see, it put the data into the row below where it should go
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 31

Expert Comment

ID: 39249580
Well I saw this row and thought it was a sample so I deleted it fine no problem change the following:

In Module1 there is a Sub Called CreateNewCardLoad
change this line
MaxRow = WS.UsedRange.Rows.Count + 1

to be
MaxRow = WS.UsedRange.Rows.Count


Author Comment

ID: 39251622
Works perfectly, gowflow, thanks.

I need the card number inserted into the blank xls (the newly created xls file) to be formatted so there is no spaces or dashes. Just one solid 16 digit number NOT in scientific notation. Do you want me to ask another question for that? Because I also need it imported into Applicant Status that way as well.
LVL 31

Expert Comment

ID: 39251851
Yes please as this is a complete different module and to incoroporate it wether in this file or in applicant status is no sweat.

Author Closing Comment

ID: 39253021
Gowflow is fantastic!

And I will add the formatting of the card number question here. Thanks once again, gowflow.

Featured Post

New feature and membership benefit!

New feature! Upgrade and increase expert visibility of your issues with Priority Questions.

Question has a verified solution.

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

Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

783 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