Solved Format multiple currencies based on a value (1 Viewer)

L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
Hi
In one excel report that I extract from access database, I have two columns which outline mixed currencies, usd or eur.
Before, in the old report, the format was just currency “none” and I had used the below line, it worked just fine.
Code: 
        .Range("M4", "N" & i).NumberFormat = "#,##0.00;-#,##0.00"

Now there is a new report which uses mixed currencies and I have to format the number based on another field (field name curr)
which can have only two possible values, E or S. E stands for Eur while S for USD

I have tried the below lines but it captures always the Else, formats all numbers as per Else no matter if the field is E or S
Code: 
If ("AF" & i) = "E" Then
.Range("M4", "N" & i).NumberFormat = "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)"
Else
.Range("M4", "N" & i).NumberFormat = "_([$$-x-euro2] * #,##0.00_);_([$$-x-euro2] * (#,##0.00);_([$$-x-euro2] * ""-""??_);_(@_)"
End If

In the first line, i have tried several options such as
If Curr = "E" Then
If Me.Curr = "E"
plus few more attempts
but none of those worked.

What should I do ?

Thanks in advance.
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
I would expect you would need to use Range and Value for your test?
Why use it one place, but not the other? :(
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
Gasman said:
I would expect you would need to use Range and Value for your test?
Why use it one place, but not the other? :(
Click to expand...

I have used also this one but doesn't work
IF .Range("AF" & i).Value = "E" then
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
Why not say that in the first place? :mad:
I suggest you walk through your code and inspect the values?
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
Hi,
with the below code, i can extract date from access to excel

There is a table with a field "freight" as number double and a field curre with two possible values, E or S , e stands for eur , s for dollars.

Te objective is to format the freight to USD or EUR based on the value on curre



anonymous image hosting


Code: 
Private Sub Btn1_Click()
On Error GoTo SubError

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rsBS As DAO.Recordset
    Dim i As Integer

    'Show user work is being performed
    DoCmd.Hourglass (True)

    '*********************************************
    '              RETRIEVE DATA
    '*********************************************
    'SQL statement to retrieve data from database

     SQL = "SELECT Forma1.IDM, Forma1.bk, Forma1.freight, Forma1.curre " & _
        "FROM Forma1;"

   'Execute query and populate recordset
    Set rsBS = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


    'If no data, don't bother opening Excel, just quit
    If rsBS.RecordCount = 0 Then
        MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
        GoTo SubExit
    End If
    '*********************************************
    '             BUILD SPREADSHEET
    '*********************************************
    'Create an instance of Excel and start building a spreadsheet

    'Early Binding
    Set xlApp = Excel.Application

    xlApp.Visible = False
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    Range("A4").Select
    ActiveWindow.FreezePanes = True
' Here I try to remove grid
    xlSheet.Activate
    ActiveWindow.DisplayGridlines = False

With xlSheet
        .Name = "IMPORT BLss"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 10

        'Format Labels
        .Range("A1").Value = "ID"
        .Range("B1").Value = "BK"
        .Range("C1").Value = "FREIGHT"
        .Range("D1").Value = "CURRENCY"

        'provide initial value to row counter
        i = 2
        'Loop through recordset and copy data from recordset to sheet
        Do While Not rsBS.EOF

    .Range("A" & i).Value = Nz(rsBS!IDM, "")
    .Range("B" & i).Value = Nz(rsBS!bk, "")
    .Range("C" & i).Value = Nz(rsBS!freight, "")
    .Range("D" & i).Value = Nz(rsBS!curre, "")

            i = i + 1
            rsBS.MoveNext

            Loop

End With

SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    xlApp.Visible = True
    rsBS.Close
    Set rsBS = Nothing
    Exit Sub

SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub

I have tried this ( i paste it between "loop" and "End With" but doesn't work

Code: 
If ("D" & i) = "E" Then
.Range("C" & i).NumberFormat = "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)"
Else
.Range("C" & i).NumberFormat = "_([$$-x-euro2] * #,##0.00_);_([$$-x-euro2] * (#,##0.00);_([$$-x-euro2] * ""-""??_);_(@_)"
End If

I am not programmer, don't know much about vba, i am just an access enthusiast and i make some "blind" code copy paste and put more things into rolling a bit better
 
Last edited:
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
Why not just use CopyFromRecordset ?
Plus I would use excel macro recording to record setting the required currency?
Then review that code.?
Still believe you need .value property when comparing excel cell contents? :(
 
C

CJ_London

Super Moderator
Staff member
Local time
Today, 08:28
Joined
Feb 19, 2013
Messages
16,618
There is nothing more annoying to people trying to help you than the statement ‘it doesn’t work’

You get an error? If so what is the error message?
You get a wrong result? If so what result are you expecting? What do you get?
Nothing happens? If so what happens when you step through the code?

After 300+ posts you should know this by now

so far as I can see you have your sql but then don’t assign it to your rsbs recordset. Something mentioned in your other thread

Solved - Error number :91 = Object variable or With variable not set

Hi I get this error when i try to play with this code Error number :91 = Object variable or With variable not set The purpose, one very simple table consisted of four fields, i just want to get these fields exported in an excel sheet. Private Sub Btn1_Click() On Error GoTo SubError...
www.access-programmers.co.uk
 
Last edited:
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
CJ_London said:
There is nothing more annoying to people trying to help you than the statement ‘it doesn’t work’

You get an error? If so what is the error message?
You get a wrong result? If so what result are you expecting? What do you get?
Nothing happens? If so what happens when you step through the code?

After 300+ posts you should know this by now
Click to expand...
Hi, the extra lines i have added
Code: 
If ("D" & i) = "E" Then ...
doesn't change the result, no error message nothing, but excel layout is not affected, with or without these extra lines, the excel looks the same.
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
That is because you have not changed anything? :mad:
You need to set your recordset before you can use it?
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
Gasman said:
Why not just use CopyFromRecordset ?
Plus I would use excel macro recording to record setting the required currency?
Then review that code.?
Still believe you need .value property when comparing excel cell contents? :(
Click to expand...

Hi, do you mean i should use a syntax like this one ?
If ("D" & i).Value = "E" Then ...
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
Yes, but without getting the recordset, it is not going to work.
Work on one piece at a time. Get the data into the excel sheet. When that works the worry about the format.
ATM you are showing a sheet that cannot be created with your code, which is confusing as hell. :(
Which as I said before,if you walked through your code would be obvious. :(
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
Gasman said:
ATM you are showing a sheet that cannot be created with your code, which is confusing as hell. :(
Click to expand...

Why confusing ?
In the picture, there is a form and a button, once i click the button i get this excel, behind the button (SorE) is the code i have outlined on post #5 .
Now , i want in column C to get mixed currency format.
c2 and c3 as currency Eur format while , c4, c5, c6 as currency usd format.


 
Last edited:
C

CJ_London

Super Moderator
Staff member
Local time
Today, 08:28
Joined
Feb 19, 2013
Messages
16,618
Quite simply if you are getting your excel spreadsheet populated then the code you are showing is not the code you are using since the code you are showing won’t work
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
CJ_London said:
Quite simply if you are getting your excel spreadsheet populated then the code you are showing is not the code you are using since the code you are showing won’t work
Click to expand...
Hi CJ London
On the post #5, i have outlined two pieces of code. The first one, populates the excel (but doesn't format the column C).
In this excel, the column C is just number. In column D it displays S or E.

My goal is to format column C based on value on column D.
I am trying to add a piece of code in the existing one in which,
if D2 is "E" then C2 will be formated as currency Euro,
if D2 is "S" , the C2 will be formated as currency dollar.

So, in post #5, there is a second piece of code, i have tried to add it in the first one
but this code doesn't change the excel , doesn;t format at all anything. I have tried several attempts.
In few cases, the whole column C gets formated as USD or Eur, no matter if in D there is an "S" or "E"

ps, i am not a programmer nor a native English speaker, apologies if my english doesn't explain the whole problem in a good way.
I have tried to understand the VBA but seems God didn't make me clever enough for this.
I find code which then i replace field names and after tests, it works in my job and this is just fine for me.
 
arnelgp

arnelgp

..forever waiting... waiting for jellybean!
Local time
Today, 15:28
Joined
May 7, 2009
Messages
19,247
change the code of your button to this:
Code: 
Private Sub Btn1_Click()
On Error GoTo SubError

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rsBS As DAO.Recordset
    Dim i As Integer

    'Show user work is being performed
    DoCmd.Hourglass (True)

    '*********************************************
    '              RETRIEVE DATA
    '*********************************************
    'SQL statement to retrieve data from database

     SQL = "SELECT Forma1.IDM, Forma1.bk, Forma1.freight, Forma1.curre " & _
        "FROM Forma1;"

   'Execute query and populate recordset
    Set rsBS = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


    'If no data, don't bother opening Excel, just quit
    If rsBS.RecordCount = 0 Then
        MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
        GoTo SubExit
    End If
    '*********************************************
    '             BUILD SPREADSHEET
    '*********************************************
    'Create an instance of Excel and start building a spreadsheet

    'Early Binding
    Set xlApp = Excel.Application

    xlApp.Visible = False
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    

With xlSheet
        'arnelgp freeze pane
        .Activate
        .Range("A2").Select
        With ActiveWindow
            .FreezePanes = False
            .ScrollRow = 1
            .ScrollColumn = 1
            .FreezePanes = True
        End With
        'end arnelgp
        
        .Name = "IMPORT BLss"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 10

        'Format Labels
        .Range("A1").Value = "ID"
        .Range("B1").Value = "BK"
        .Range("C1").Value = "FREIGHT"
        .Range("D1").Value = "CURRENCY"

        'provide initial value to row counter
        i = 2
        'Loop through recordset and copy data from recordset to sheet
        Do While Not rsBS.EOF

    .Range("A" & i).Value = Nz(rsBS!IDM, "")
    .Range("B" & i).Value = Nz(rsBS!bk, "")
    'arnelgp
    With .Range("C" & i)
        .Value = Nz(rsBS!freight, "")
        If Val(rsBS!freight & "") <> 0 And Len(rsBS!curre & "") <> 0 Then
            .NumberFormat = Switch(rsBS!curre = "E", _
                            "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)", _
                            rsBS!curre = "S", _
                            "_([$$-x-euro2] * #,##0.00_);_([$$-x-euro2] * (#,##0.00);_([$$-x-euro2] * ""-""??_);_(@_)", _
                            True, "")
        End If
    End With
    'end arnelgp
    .Range("D" & i).Value = Nz(rsBS!curre, "")

            i = i + 1
            rsBS.MoveNext

            Loop

    .Columns("B:B").Select
    .Columns("B:B").EntireColumn.AutoFit
    .Cells(2, 1).Select
End With

SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    xlApp.Visible = True
    rsBS.Close
    Set rsBS = Nothing
    Exit Sub

SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub
 
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
arnelgp said:
change the code of your button to this:
Code: 
Private Sub Btn1_Click()
On Error GoTo SubError

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rsBS As DAO.Recordset
    Dim i As Integer

    'Show user work is being performed
    DoCmd.Hourglass (True)

    '*********************************************
    '              RETRIEVE DATA
    '*********************************************
    'SQL statement to retrieve data from database

     SQL = "SELECT Forma1.IDM, Forma1.bk, Forma1.freight, Forma1.curre " & _
        "FROM Forma1;"

   'Execute query and populate recordset
    Set rsBS = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)


    'If no data, don't bother opening Excel, just quit
    If rsBS.RecordCount = 0 Then
        MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
        GoTo SubExit
    End If
    '*********************************************
    '             BUILD SPREADSHEET
    '*********************************************
    'Create an instance of Excel and start building a spreadsheet

    'Early Binding
    Set xlApp = Excel.Application

    xlApp.Visible = False
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
   

With xlSheet
        'arnelgp freeze pane
        .Activate
        .Range("A2").Select
        With ActiveWindow
            .FreezePanes = False
            .ScrollRow = 1
            .ScrollColumn = 1
            .FreezePanes = True
        End With
        'end arnelgp
       
        .Name = "IMPORT BLss"
        .Cells.Font.Name = "Calibri"
        .Cells.Font.Size = 10

        'Format Labels
        .Range("A1").Value = "ID"
        .Range("B1").Value = "BK"
        .Range("C1").Value = "FREIGHT"
        .Range("D1").Value = "CURRENCY"

        'provide initial value to row counter
        i = 2
        'Loop through recordset and copy data from recordset to sheet
        Do While Not rsBS.EOF

    .Range("A" & i).Value = Nz(rsBS!IDM, "")
    .Range("B" & i).Value = Nz(rsBS!bk, "")
    'arnelgp
    With .Range("C" & i)
        .Value = Nz(rsBS!freight, "")
        If Val(rsBS!freight & "") <> 0 And Len(rsBS!curre & "") <> 0 Then
            .NumberFormat = Switch(rsBS!curre = "E", _
                            "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)", _
                            rsBS!curre = "S", _
                            "_([$$-x-euro2] * #,##0.00_);_([$$-x-euro2] * (#,##0.00);_([$$-x-euro2] * ""-""??_);_(@_)", _
                            True, "")
        End If
    End With
    'end arnelgp
    .Range("D" & i).Value = Nz(rsBS!curre, "")

            i = i + 1
            rsBS.MoveNext

            Loop

    .Columns("B:B").Select
    .Columns("B:B").EntireColumn.AutoFit
    .Cells(2, 1).Select
End With

SubExit:
On Error Resume Next
    DoCmd.Hourglass False
    xlApp.Visible = True
    rsBS.Close
    Set rsBS = Nothing
    Exit Sub

SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub
Click to expand...
Many many thanks arnelgp
I will try this code at home later today and i am sure it will work. From a simple glance, it looks just what it needs to mae my report fast perfect and good looking.
 
Gasman

Gasman

Enthusiastic Amateur
Local time
Today, 08:28
Joined
Sep 21, 2011
Messages
14,319
Makes column D redundant now. :)
 
Last edited:
L

Leo_Polla_Psemata

Registered User.
Local time
Today, 00:28
Joined
Mar 24, 2014
Messages
364
arnelgp said:
change the code of your button to this:
Click to expand...

Hi arnelpg ,
many many thanks,one more time,for your help.
The code worked just fine for those columns that we need to format the currency.

Now, there are few more columns that need formula, this formula is a bit complicated and it is a different one if the currency is Eur or USD.

Based on your code, i made the below for formula.
The result is positive, the excel spreadsheet returns the correct result.
The question is if this bit of code would need any extra lines that would prevent errors. You see, i have removed some lines.

Code: 
    With .Range("N" & i)
        .Formula = Switch(rsBS!CURRE = "S", _
                            "=[[complicated formula]]/1.0443", _
                            rsBS!CURRE = "E", _
                            "=[[complicated formula]]", _
                            True, "")
    End With

Your code for the format
Code: 
    'arnelgp
    With .Range("C" & i)
        .Value = Nz(rsBS!freight, "")
        If Val(rsBS!freight & "") <> 0 And Len(rsBS!curre & "") <> 0 Then
            .NumberFormat = Switch(rsBS!curre = "E", _
                            "_([$€-x-euro2] * #,##0.00_);_([$€-x-euro2] * (#,##0.00);_([$€-x-euro2] * ""-""??_);_(@_)", _
                            rsBS!curre = "S", _
                            "_([$$-x-euro2] * #,##0.00_);_([$$-x-euro2] * (#,##0.00);_([$$-x-euro2] * ""-""??_);_(@_)", _
                            True, "")
        End If
    End With
 
You must log in or register to reply here.

Similar threads

L
Format currency to euro in VBA range and loop
Replies
1
Views
1,035
Leo_Polla_Psemata
L
L
Retrieve excel from access (vol 4) , extended format , alternative color
Replies
7
Views
578
arnelgp
arnelgp
G
Solved Increment a value
Replies
3
Views
428
goncalo
G
A
calcculte Total selling based on format filed curancey
Replies
10
Views
659
AHMEDRASHED
A
L
Solved Extract excel from access
Replies
4
Views
722
Leo_Polla_Psemata
L

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom