We help IT Professionals succeed at work.

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

JaseSt
JaseSt asked
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

Glenn RayExcel VBA Developer
Top Expert 2014

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

Author

Commented:
Yes, he should. He's been a tremendous help to me.
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
If Not FoundIt Then
    ActiveWorkbook.Worksheets.Add After:=ActiveWorkbook.Worksheets(Worksheets.Count)
    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
    
    With WSCur.QueryTables.Add(Connection:= _
        "URL;http://www.xe.com", Destination:=WSCur.Range("A1") _
        )
        .Name = "xe.com"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = 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

Open in new window


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
        
        For Each Rng In Range(Target.Address)
            If Rng.Column = 10 Then
                I = Range(Rng.Address).Row
                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

Open in new window


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
        
        For Each Rng In Range(Target.Address)
            If Rng.Column = 9 Then
                I = Range(Rng.Address).Row
                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

Open in new window


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

Author

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.
ok shoot.
gowflow

Author

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.

Author

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

Author

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?
What was the button in MC to create the Excel pushtobook ??
gowflow

Author

Commented:
It is on the MC Consolidated page and labeled: Push to Book 1
ok we can go ahead with your suggestion in ID: 37249363
gowflow

Author

Commented:
Great! Am looking forward to it.