We help IT Professionals succeed at work.

# continuing on from previous question - adding to what that solution gave

on
gowflow, now we need to go a step further with that email being imported to the Wire-Staging-FBME sheet, so here's what we need to do..

Can you get the conversion rate from USD to Euros from http://www.xe.com ? If not, not a biggie and you can use Oanda as you did before (a solution I LOVE, by the way) The reason I suggest xe.com is Earthport uses them to assess their wire fee. Either way, here's what we need to do when importing an email into Wire-Staging-FBME.

1. To Col J: paste the amount from the email body, after the EUR  (example: Amount: EUR 850.00)
2. To Col i:  If the amount in Col J is <USD 10k, then divide \$2.00 by the USD to Euro conversion rate.
If the amount in Col J is USD 10k-50k, then divide \$5.00 by the USD to Euro conversion rate
If the amount in Col J is USD is =USD 50k,  then divide \$10.00 by the USD to Euro conversion rate
3. To Col L: = Col J - Col i
4. To Col M: =IF(L793*1.85%<20, 20, L793*1.85%)
5. To Col F: =IF(L793*1.85%<20, L793-20, L793-(L793*1.85%))

Also, if I have to manually insert a value into Col J (as not all values come from an imported email), then I want the same thing to happen as above.

That's it. In a future related question I will want to be able to modify the loading fee rates as we did with the Mastercard sheet.

Comment
Watch Question

## View Solution Only

Excel VBA Developer
Top Expert 2014

Commented:
goflow should get paid for all this work! :-)

Commented:
Yes, he should. He's been a tremendous help to me.
Partner
Commented:
ok here it is.
1) Make a new copy of your latest Visa file and save it onto a new name.
2) Open the newly created Visa file and goto VBA and doubleclick on module1
3) View 1 sub at a time by clciking on the bottom left icon.
4) Copy the below code after any End sub

``````Function GetEURRatesNew() As Double
Dim WSCur As Worksheet, WS As Worksheet
Dim Cel As Range
Dim FoundIt As Boolean

Application.ScreenUpdating = False
FoundIt = False
For Each WS In ActiveWorkbook.Worksheets
If WS.Name = "Currency Rates" Then
FoundIt = True
Exit For
End If
Next WS
Set WSCur = ActiveSheet
WSCur.Name = "Currency Rates"
Else
Set WSCur = Sheets("Currency Rates")
End If

'Sheets(sht).Activate
Set Cel = WSCur.UsedRange.Find(Format(DateValue(Now), "Mmm dd, yyyy,"), LookIn:=xlValues, lookat:=xlPart)
If Not Cel Is Nothing And WSCur.UsedRange.Rows.Count > 1 Then

Else
WSCur.UsedRange.Delete

"URL;http://www.xe.com", Destination:=WSCur.Range("A1") _
)
.Name = "xe.com"
.FieldNames = True
.RowNumbers = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SaveData = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingAll
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

End If
Set Cel = WSCur.UsedRange.Find("EUR", LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
GetEURRatesNew = Cel.Offset(2, 0).Value
End If

Application.ScreenUpdating = True

End Function
``````

5) SAVE the workbook.
6) In the left pane in VBA doubleclick on the Sheet Wire-Staging-FBME and paste the below code there.

``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, aCell As Range
Dim EURROE As Double
Dim I As Long

Application.EnableEvents = False

On Error GoTo Err
If Not Intersect(Target, Columns(10)) Is Nothing Then

If Rng.Column = 10 Then
Exit For
End If
Next Rng

If I = 0 Then Exit Sub
'Disabled by gowflow fix 1.4 currency rate EUR/USD
'to be replaced by realtime currency rate
'Range("V" & I).Value = 1.4

'Get Real time Currency Rate
EURROE = GetEURRatesNew()
Select Case Range("J" & I).Value

Case Is <= 10000
Range("I" & I).Value = 2 / EURROE

Case 10000.01 To 50000
Range("I" & I).Value = 5 / EURROE

Case Is > 50000
Range("I" & I).Value = 10 / EURROE

End Select

Range("L" & I).Formula = "=" & Range("J" & I).Address & "-" & Range("I" & I).Address
Range("M" & I).Formula = "=IF(L" & I & "*1.85%<20, 20,L" & I & "*1.85%)"
Range("F" & I).Formula = "=IF(L" & I & "*1.85%<20, L" & I & "-20, L" & I & "-(L" & I & "*1.85%))"

End If
Application.EnableEvents = True
Exit Sub
Err:
If Err.Number <> 1004 Then MsgBox Err.Description
Application.EnableEvents = True

End Sub
``````

7) SAVE the workbook.
8) doubleclick on the sheet WU-Staging-FBME in VBA left pane and select to view 1 sub at a time by clicking on the bottom left icon and choose Worksheet_change event and delete the whole code.
9) COPY Paste the below code in there

``````Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, aCell As Range
Dim I As Long

Application.EnableEvents = False

On Error GoTo Err
If Not Intersect(Target, Columns(9)) Is Nothing Then

If Rng.Column = 9 Then
Range("U" & I).Formula = "=" & Rng.Address
Exit For
End If
Next Rng

If I = 0 Then Exit Sub
'Disabled by gowflow fix 1.4 currency rate EUR/USD
'to be replaced by realtime currency rate
'Range("V" & I).Value = 1.4

'Get Real time Currency Rate
Range("V" & I).Value = GetEURRatesNew()

Range("W" & I).Formula = "=" & Range("V" & I).Address & "*5%"
Range("X" & I).Formula = "=" & Range("V" & I).Address & "+" & Range("W" & I).Address
Range("Y" & I).Formula = "=" & Range("U" & I).Address & "/" & Range("X" & I).Address
Range("Z" & I).Formula = "=" & Range("Y" & I).Address & "*7.5%"
Range("T" & I).Formula = "=IF(Y" & I & "*7.5%<75, Y" & I & "-75, Y" & I & "-(Y" & I & "*7.5%))"
Range("S" & I).Value = "EUR"

End If
Application.EnableEvents = True
Exit Sub
Err:
If Err.Number <> 1004 Then MsgBox Err.Description
Application.EnableEvents = True
End Sub
``````

10) SAVE the wrokbook and Exit
11) Run the workbook and try both Wire-Staging-FBME amounts and WU-Stagin-FBME the site has been changed to read http://www.xe.com and updated as above request.

Pls let me know.
gowflow

Commented:
Thank you, gowflow, it worked just fantastic for the Earthport emails and will test it on a Western Union emails when one comes in. Should get one today or tomorrow.

While waiting, if you wanted to work on another, let me know. It is the next step in this process to create a separate spreadsheet and email it in an attachment to the bank, much as you did with the MasterCard workbook.
Partner

Commented:
ok shoot.
gowflow

Commented:
Ok, I'm going to close this one so that I can ask a related question. I will continue to test and let you know if there are any problems. Great work, gowflow. Thanks again.

Commented:
now if you think this related question is two or three, let me know and I'll split it up:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27481068.html
Partner

Commented:
Well now that you made the question in one maybe too late to split it up will be up to you to accept it when we reach the below points:
1) I need clarification on the button to create the file it seem you want it to pull data from 2 sheets will it be always looking in the 2 sheets each time it is run or you need 1 button for each sheet to run separately ?
2) Will the file created include infor from the 2 sheets in 1 same file or 1 file for every sheet ?

Upon your reply I could then propose how to split this into questions so you would be enlightented to when close the question.

gowflow

Commented:
No it is not too late. You can do one part and I'll ask another related question. You can break it up by the 3 points.

1. Yes, it will always look in the two sheets. One button to look in two sheets would be best.

2. The file created will be one sheet, getting data from the two sheets. So the button when clicked will gather data from the two sheets and compile that data into one sheet.

How about you just do part 1. Then I'll submit related questions for part 2 then when done, give you the last related question which would be part 3?
Partner

Commented:
What was the button in MC to create the Excel pushtobook ??
gowflow

Commented:
It is on the MC Consolidated page and labeled: Push to Book 1
Partner

Commented: