Part 8 to: Import more data into spreadsheet

Posted on 2013-06-14
Last Modified: 2013-06-17
Continuing on from:

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 29

Accepted Solution

gowflow earned 500 total points
Comment Utility
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 = ""
Blindcc = ""

'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) _
    & ""

  '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

Comment Utility
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

Comment Utility
as you can see, it put the data into the row below where it should go
LVL 29

Expert Comment

Comment Utility
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.


Author Comment

Comment Utility
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 29

Expert Comment

Comment Utility
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

Comment Utility
Gowflow is fantastic!

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

Author Comment

Comment Utility

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

What is a Form List Box? (skip if you know this) The forms List Box is the alternative to the ActiveX list box. If you are using excel 2007, you first make sure you have a developer tab (click the Orb)->"Excel Options"->Popular->"Show Developer tab…
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

744 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now