Automatically apply USD to Euro conversion from a formula

Posted on 2011-10-31
Last Modified: 2012-08-14
Have a spreadsheet with a cell that calculates a generic formula for converting USD amount to Euros which I have to adjust by manually looking up the real current conversion rate and applying it . However, what would be great is to have the current USD to Euro conversion rate applied automatically somehow rather than having to look it up. Is that possible?
Question by:JaseSt
    LVL 6

    Expert Comment

    an easy way to find out the value is to use

    =HYPERLINK(";to=EUR;amt="&A2, "Eur")

    you can put what ever amount in cells A2 and check that hyperlink and it will transfer it in euro.
    LVL 6

    Expert Comment


    You can also use "get external data". Find the site with the euro currency exchange table.
    Go data tab in excel, click "from web", put the site in the " address", click "go", click the table, click import and select the range in worksheet where you want to put the current currency exchange rate.

    now you have the latest current exchange rate and you can just use easy formula to convert $ to euro.
    LVL 29

    Accepted Solution

    Here you go, as we worked your previous question this solution is adapted to specifically your workbook and to the field that you need. Each time / day you import data you will get the latest currency conversion table pulled from a website that will sit in a special sheet in your workbook this has double advantage of not only updating the field you require but can also serve as a refrence to consult and chk anytime the latest current rate of conversion for main currencies.

    To apply do the following:
    1) Save your latest Visa file onto a new name
    2) Doubleclick on Module1 and paste the below function GetEURRates

    Function GetEURRates() 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"
        Set WSCur = Sheets("Currency Rates")
    End If
    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
        With WSCur.QueryTables.Add(Connection:= _
            "URL;", Destination:=WSCur.Range("A1") _
            .Name = "real-time-rates"
            .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/USD", LookIn:=xlValues, lookat:=xlWhole)
    If Not Cel Is Nothing Then
        GetEURRates = Cel.Offset(, 1).Value
    End If
    Application.ScreenUpdating = True
    End Function

    Open in new window

    3) Save the workbook
    4) Doubleclik on the sheet "WU-Staging-FBME" and display the code. click on the bottom left icon to show 1 sub at a time
    5) Delete all the code that is in Worksheet_change event and replace it by the below code.

    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 = GetEURRates()
            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
        If Err.Number <> 1004 Then MsgBox Err.Description
        Application.EnableEvents = True
    End Sub

    Open in new window

    6) SAVE the workbook and Exit
    7) Start the workbook and give it a try.

    Pls let me know your comments (You may check the new sheet Currency Rates)

    Author Comment

    Thank you, gowflow. Looking forward to trying it. Have to wait for Josef to send me his spreadsheet though. Are you saying the conversion code is activated with the Sum-Up Completed Batches button?
    LVL 29

    Expert Comment

    yes no need to wait !! you can simply try it by inputing manually any value in col I
    LVL 33

    Expert Comment

    This function will get the rate from a webservice and can be used as a function on a worksheet.

    I've included a small test sub to demonstrate.

    Option Explicit
    Function CurrencyConversionRate(fromCurrency As String, toCurrency As String) _
             As Double
    Dim xml As Object
    Dim result As String
    Dim lFirstChar As Long
    Dim lLastChar As Long
        Set xml = CreateObject("MSXML2.XMLHTTP.6.0")
        xml.Open "GET", _
                 "" & fromCurrency & "&ToCurrency=" & toCurrency, False
        result = xml.responsetext
        ' parse result for response
        lFirstChar = InStr(result, "webserviceX.NET")
        lFirstChar = InStr(lFirstChar, result, ">") + 1
        lLastChar = InStr(lFirstChar, result, "<")
        CurrencyConversionRate = Mid$(result, lFirstChar, lLastChar - lFirstChar)
    End Function
    Sub test()
    Dim USDToEUR As Double
        USDToEUR = CurrencyConversionRate("USD", "EUR")
        MsgBox "Exchange rate: " & Format(USDToEUR, "$0.00") & " to 1€"
    End Sub

    Open in new window

    LVL 29

    Expert Comment

    Did you have a chance to try it out ?

    Author Comment

    Yes, I did by doing just as you said, and it is awesome!!! Perfect! I want to try it out when I get more batches to work with, but it is really a great solution. Thank you.

    Question: What happens Currency Rates page when I run it again? Maybe I'll try it....

    Ok, I see. It just gets replaced.

    Marvelous, gowflow. Really appreciate it. I think we can just close this out as it looks like it works just fine. Saves me a lot of time and potential for error.

    Thank you!

    Author Closing Comment

    The excel master, gowflow, strikes again. Great solution. Really appreciate his work!

    Author Comment

    Next up, if you're willing gowflow, is still more work on the WU Staging FBME sheet.

    I need to keep track of the ongoing balance with what I send as batches to Josef and what he wires back to us.

    So if I send him, for example, a spreadsheet with 5 batches that total $35,000 he then picks up those individual wires, however, he will hold on to the money until he gets more pickups (more money) and then sends wires back to us minus his commission of .5%.

    As a note here, we probably should keep track of this on a different sheet within the Visa workbook.

    So what I need to keep track of is:

    New sheet Col a: how much total money I've told Joseph to pick up  - the sums of Col i

    New sheet Col b: how much money he's wired back to us - this comes in a standardized email that we will need to import and put into a column of the spreadsheet (attached is the email - 'From: Offshore Eagle')

    New sheet Col c: take out .5% of the totals of Col i - which equals his commission. (He takes out .5% from what he actually picks up, not what we send him because sometimes there is a difference.)

    New sheet Col d: then adding his commission (New sheet Col c) to the amount he wired back to us (New sheet Col b) should equal New sheet Col a.

     But, we need to keep track of the difference between Col a (what he says he picked up)  and Col d because we need to know how much he has or has not wired back to us. That is our account balance with Josef.

    Also for every wire he sends us (from New sheet Col b) , the bank takes out $5.00 so that has to be calculated in the outstanding balance with him, so maybe this should be col d and the balance col e?

    Does this make sense? Maybe I made it too confusing. Let me know and I'll post it as a question. Thank you!
    LVL 29

    Expert Comment

    I like it when we get to something jucy !! If I didn't learn anything about all the posts ... Just this one (currency auto choeck) enough for me to blow my mind !!! I like challenges like htis one and really useful on so many fronts not even funny !!!!

    Let me digest your new litterature and will revert
    LVL 29

    Expert Comment

    ok got roughly the picture pls post the question and if anything to clarify I will ask then. I think that you will need to input manually the amount of the email as cannot make a link between the file that you import from joseph and the email received so they endup in the same row. An other thing you forgot to mention a date in your fields it is important for tracing back history I guess its the date that you import your file that should be or an other date up to you. the rest I will see when I go along

    Author Comment

    here it is:

    Not sure if this one is so juicy. And I'm not sure how I put it is what I want, but got to start somewhere.

    Thank you, gowflow.

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    6 Surprising Benefits of Threat Intelligence

    All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

    How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
    This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
    This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
    Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

    737 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

    22 Experts available now in Live!

    Get 1:1 Help Now