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

[Leo_Polla_Psemata]

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.

        .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

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]

I would expect you would need to use Range and Value for your test?
Why use it one place, but not the other?

 

[Leo_Polla_Psemata]

I would expect you would need to use Range and Value for your test?
Why use it one place, but not the other?

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

 

[Gasman]

Why not say that in the first place?
I suggest you walk through your code and inspect the values?

 

[Leo_Polla_Psemata]

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

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

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

 

[Gasman]

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?

 

[CJ_London]

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

 

[Leo_Polla_Psemata]

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

Hi, the extra lines i have added

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]

That is because you have not changed anything?
You need to set your recordset before you can use it?

 

[Leo_Polla_Psemata]

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?

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

 

[Gasman]

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.

 

[Leo_Polla_Psemata]

ATM you are showing a sheet that cannot be created with your code, which is confusing as hell.

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.

 

[CJ_London]

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

 

[Leo_Polla_Psemata]

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

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]

change the code of your button to this:

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

 

[Leo_Polla_Psemata]

change the code of your button to this:

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

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]

I can see I missed the fact that you had not even used Range or Cell reference?

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

 

[arnelgp]

here is a sneak preview:

 

[Gasman]

Makes column D redundant now.

 

[Leo_Polla_Psemata]

change the code of your button to this:

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.

    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

    '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