Userform Change of Currency

[gilly01625]

Hey,

I have a userform which when a command button is clicked, it populates a table on a worksheet with the values of text boxes, and combo boxes inputted by the user. I have a finance section which allows the user to input pay per hour - however I need to add an option to select a country of which pay will be issued; options being UK and Australia.

Is there a way that when a certain country is selected, it changes the accounting format on a worksheet to display either £ or $?

Thanks

 

[dmt32]

Hi

You should be able to do what you want by applying Range.NumberFormat when you post the value to the range.

As you have not shared any of your code this is just a generalisation of how you could achieve this

Assuming that you have two optionbuttons to select the required currency type then something like this may do what you want

'declare variable and datatype
    Dim PayPerHour As Currency
    'corece text to currency data type
    PayPerHour = CCur(Me.txtPayPerHour.Value)

    'post to range & apply selected numberformat
     With Cells(5, 10)
        .Value = PayPerHour
        .NumberFormat = IIf(Me.OptAUS.Value, "[$$-en-AU]#,##0.00", "$#,##0.00")
    End With

In this example I have used CCur type conversion function to coerce the string expression in the textbox to Currency data type. Do though be aware that if an expression passed to the function is outside the range of the Currency data type, an error occurs - your code will therefore, need to handle user input errors.

Also, to obtain the numberformat strings, I just turned the macro recorder on and formatted the selected cell for each currency type – if examples posted do not do what you want, suggest you do same to obtain correct numberformat string for your system.



Hope Helpful



Dave

 

[gilly01625]

Sorry, should have been more specific. I have a Combo Box with UK and AUS as the options (top left in frame 'Country'), I then also have Text Boxes for input of hourly rate, day rate, and salary (middle in frame 'Income') - these are the text boxes where the user inputs a value for currency. Does that help?
Thanks

 

[dmt32]

Hi
to understand your project forum would need to see the code behind your form or better still, a copy of the workbook with dummy data placed in a file sharing site like dropbox.
Without this, I can only offer suggestion / guesses what might work for you

An update to my first post that uses a combobox to select the country currency

'declare variable and datatype
    Dim Hourly            As Currency, Daily As Currency, Salary As Currency
    Dim CurrencyFormat    As String

    'corece text to currency data type
    Hourly = CCur(Me.txtHourly.Value)
    Daily = CCur(Me.txtDaily.Value)
    Salary = CCur(Me.txtSalary.Value)
    
    CurrencyFormat = IIf(Me.txtCountry.Value = "AUS", "[$$-en-AU]#,##0.00", "$#,##0.00")

    'post to range & apply selected numberformat
     With Cells(5, 10)
        .Value = Hourly
        .NumberFormat = CurrencyFormat
    End With
    
    With Cells(5, 11)
        .Value = Daily
        .NumberFormat = CurrencyFormat
    End With
    
    With Cells(5, 12)
        .Value = Salary
        .NumberFormat = CurrencyFormat
    End With

You will need to change the control names I have used to those in your userform.

If you need further guidance to include suggestion in to your project then please provide copy of your code / workbook as mentioned above.

Dave

 

[gilly01625]

Here is my code.

'===================================================================================================
'===================================================================================================
'New Record to Table
'===================================================================================================
'Add
'===================================================================================================

Private Sub btnAdd_Click()
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim last_Row As Long
    last_Row = Application.WorksheetFunction.CountA(sh.Range("C:C"))
    
    If Me.cmbCountry.Value = "UK" Then
    
        ThisWorkbook.Sheets("Admin").Range("B2").Value = Range("B2") + 1
        ThisWorkbook.Sheets("Admin").Range("D2").Value = "UK-WREF"
        Me.txtWREF = ThisWorkbook.Sheets("Admin").Range("D1").Value
        
    End If
    
    If Me.cmbCountry.Value = "AUS" Then
        
        ThisWorkbook.Sheets("Admin").Range("B3").Value = Range("B3") + 1
        ThisWorkbook.Sheets("Admin").Range("D2").Value = "AUS-WREF"
        Me.txtWREF = ThisWorkbook.Sheets("Admin").Range("D1").Value
    
    End If
    
    sh.Range("C" & last_Row + 1).Value = "=Row()-6"
    sh.Range("D" & last_Row + 1).Value = Me.txtWREF.Value
    sh.Range("E" & last_Row + 1).Value = Me.cmbClient.Value
    sh.Range("F" & last_Row + 1).Value = Me.txtSubClient.Value
    sh.Range("G" & last_Row + 1).Value = Me.cmbType.Value
    sh.Range("H" & last_Row + 1).Value = Me.txtLocation.Value
    sh.Range("I" & last_Row + 1).Value = Me.txtDateStart.Value
    sh.Range("J" & last_Row + 1).Value = Me.txtDateEnd.Value
    sh.Range("K" & last_Row + 1).Value = Me.txtS1Start.Value
    sh.Range("L" & last_Row + 1).Value = Me.txtS1End.Value
    sh.Range("M" & last_Row + 1).Value = Me.txtS2Start.Value
    sh.Range("O" & last_Row + 1).Value = Me.txtS2End.Value
    sh.Range("O" & last_Row + 1).Value = Me.txtS3Start.Value
    sh.Range("P" & last_Row + 1).Value = Me.txtS3End.Value
    sh.Range("Q" & last_Row + 1).Value = Me.txtQuotedHours.Value
    sh.Range("R" & last_Row + 1).Value = Me.txtActualHours.Value
    sh.Range("S" & last_Row + 1).Value = Me.txtMileage.Value
    sh.Range("T" & last_Row + 1).Value = Me.txtPetrol.Value
    sh.Range("U" & last_Row + 1).Value = Me.txtParking.Value
    sh.Range("V" & last_Row + 1).Value = Me.txtHourly.Value
    sh.Range("W" & last_Row + 1).Value = Me.txtDay.Value
    sh.Range("X" & last_Row + 1).Value = Me.txtSalary.Value
    sh.Range("Y" & last_Row + 1).Value = Me.txtTotal.Value
    sh.Range("Z" & last_Row + 1).Value = Me.txtIID.Value
    sh.Range("AA" & last_Row + 1).Value = Me.cmbPAYE.Value
    sh.Range("AB" & last_Row + 1).Value = Me.txtNotes.Value
    sh.Range("AC" & last_Row + 1).Value = Now
    sh.Range("AD" & last_Row + 1).Value = Me.cmbCountry.Value
    
    Me.cmbCountry.Value = ""
    Me.txtWREF.Value = ""
    Me.cmbClient.Value = ""
    Me.txtSubClient.Value = ""
    Me.cmbType.Value = ""
    Me.txtLocation.Value = ""
    Me.txtDateStart.Value = ""
    Me.txtDateEnd.Value = ""
    Me.txtS1Start.Value = ""
    Me.txtS1End.Value = ""
    Me.txtS2Start.Value = ""
    Me.txtS2End.Value = ""
    Me.txtS3Start.Value = ""
    Me.txtS3End.Value = ""
    Me.txtQuotedHours.Value = ""
    Me.txtActualHours.Value = ""
    Me.txtMileage.Value = ""
    Me.txtPetrol.Value = ""
    Me.txtParking.Value = ""
    Me.txtHourly.Value = ""
    Me.txtDay.Value = ""
    Me.txtSalary.Value = ""
    Me.txtTotal.Value = ""
    Me.txtIID.Value = ""
    Me.cmbPAYE.Value = ""
    Me.txtNotes.Value = ""
    
    Call Refresh_Data
    
End Sub

'===================================================================================================
'Clear
'===================================================================================================

Private Sub btnClear_Click()

    Me.txtWID.Value = ""
    Me.cmbCountry.Value = ""
    Me.txtWREF.Value = ""
    Me.cmbClient.Value = ""
    Me.txtSubClient.Value = ""
    Me.cmbType.Value = ""
    Me.txtLocation.Value = ""
    Me.txtDateStart.Value = ""
    Me.txtDateEnd.Value = ""
    Me.txtS1Start.Value = ""
    Me.txtS1End.Value = ""
    Me.txtS2Start.Value = ""
    Me.txtS2End.Value = ""
    Me.txtS3Start.Value = ""
    Me.txtS3End.Value = ""
    Me.txtQuotedHours.Value = ""
    Me.txtActualHours.Value = ""
    Me.txtMileage.Value = ""
    Me.txtPetrol.Value = ""
    Me.txtParking.Value = ""
    Me.txtHourly.Value = ""
    Me.txtDay.Value = ""
    Me.txtSalary.Value = ""
    Me.txtTotal.Value = ""
    Me.txtIID.Value = ""
    Me.cmbPAYE.Value = ""
    Me.txtNotes.Value = ""
    
End Sub

'===================================================================================================
'Delete
'===================================================================================================

Private Sub btnDelete_Click()

    If Me.txtWID.Value = "" Then
        MsgBox "Select a record to delete"
    Exit Sub
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim Selected_Row As Long
    Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtWID.Value), sh.Range("C:C"), 0)
    
    sh.Range("A" & Selected_Row).EntireRow.Delete
    
    Call Refresh_Data
    
    Me.txtWID.Value = ""
    Me.cmbCountry.Value = ""
    Me.txtWREF.Value = ""
    Me.cmbClient.Value = ""
    Me.txtSubClient.Value = ""
    Me.cmbType.Value = ""
    Me.txtLocation.Value = ""
    Me.txtDateStart.Value = ""
    Me.txtDateEnd.Value = ""
    Me.txtS1Start.Value = ""
    Me.txtS1End.Value = ""
    Me.txtS2Start.Value = ""
    Me.txtS2End.Value = ""
    Me.txtS3Start.Value = ""
    Me.txtS3End.Value = ""
    Me.txtQuotedHours.Value = ""
    Me.txtActualHours.Value = ""
    Me.txtMileage.Value = ""
    Me.txtPetrol.Value = ""
    Me.txtParking.Value = ""
    Me.txtHourly.Value = ""
    Me.txtDay.Value = ""
    Me.txtSalary.Value = ""
    Me.txtTotal.Value = ""
    Me.txtIID.Value = ""
    Me.cmbPAYE.Value = ""
    Me.txtNotes.Value = ""
    
End Sub

'===================================================================================================
'Save
'===================================================================================================

Private Sub btnSave_Click()

    ThisWorkbook.Save
    MsgBox "Data Saved"
    
End Sub

'===================================================================================================
'Update
'===================================================================================================

Private Sub btnUpdate_Click()

    If Me.txtWID.Value = "" Then
    
        MsgBox "Select a record to update"
    
    End If
    
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim Selected_Row As Long
    Selected_Row = Application.WorksheetFunction.Match(CLng(Me.txtWID.Value), sh.Range("C:C"), 0)
    
    sh.Range("D" & Selected_Row).Value = Me.txtWREF.Value
    sh.Range("E" & Selected_Row).Value = Me.cmbClient.Value
    sh.Range("F" & Selected_Row).Value = Me.txtSubClient.Value
    sh.Range("G" & Selected_Row).Value = Me.cmbType.Value
    sh.Range("H" & Selected_Row).Value = Me.txtLocation.Value
    sh.Range("I" & Selected_Row).Value = Me.txtDateStart.Value
    sh.Range("J" & Selected_Row).Value = Me.txtDateEnd.Value
    sh.Range("K" & Selected_Row).Value = Me.txtS1Start.Value
    sh.Range("L" & Selected_Row).Value = Me.txtS1End.Value
    sh.Range("M" & Selected_Row).Value = Me.txtS2Start.Value
    sh.Range("N" & Selected_Row).Value = Me.txtS2End.Value
    sh.Range("O" & Selected_Row).Value = Me.txtS3Start.Value
    sh.Range("P" & Selected_Row).Value = Me.txtS3End.Value
    sh.Range("Q" & Selected_Row).Value = Me.txtQuotedHours.Value
    sh.Range("R" & Selected_Row).Value = Me.txtActualHours.Value
    sh.Range("S" & Selected_Row).Value = Me.txtMileage.Value
    sh.Range("T" & Selected_Row).Value = Me.txtPetrol.Value
    sh.Range("U" & Selected_Row).Value = Me.txtParking.Value
    sh.Range("V" & Selected_Row).Value = Me.txtHourly.Value
    sh.Range("W" & Selected_Row).Value = Me.txtDay.Value
    sh.Range("X" & Selected_Row).Value = Me.txtSalary.Value
    sh.Range("Y" & Selected_Row).Value = Me.txtTotal.Value
    sh.Range("Z" & Selected_Row).Value = Me.txtIID.Value
    sh.Range("AA" & Selected_Row).Value = Me.cmbPAYE.Value
    sh.Range("AB" & Selected_Row).Value = Me.txtNotes.Value
    sh.Range("AC" & Selected_Row).Value = Now
    sh.Range("AD" & Selected_Row).Value = Me.cmbCountry.Value
    
    Me.cmbCountry.Value = ""
    Me.txtWID.Value = ""
    Me.txtWREF.Value = ""
    Me.cmbClient.Value = ""
    Me.txtSubClient.Value = ""
    Me.cmbType.Value = ""
    Me.txtLocation.Value = ""
    Me.txtDateStart.Value = ""
    Me.txtDateEnd.Value = ""
    Me.txtS1Start.Value = ""
    Me.txtS1End.Value = ""
    Me.txtS2Start.Value = ""
    Me.txtS2End.Value = ""
    Me.txtS3Start.Value = ""
    Me.txtS3End.Value = ""
    Me.txtQuotedHours.Value = ""
    Me.txtActualHours.Value = ""
    Me.txtMileage.Value = ""
    Me.txtPetrol.Value = ""
    Me.txtParking.Value = ""
    Me.txtHourly.Value = ""
    Me.txtDay.Value = ""
    Me.txtSalary.Value = ""
    Me.txtTotal.Value = ""
    Me.txtIID.Value = ""
    Me.cmbPAYE.Value = ""
    Me.txtNotes.Value = ""
    
    Call Refresh_Data
    
End Sub

'===================================================================================================
'Pull Table Contents to Userform Input Options
'===================================================================================================

Private Sub lstWorkDatabase_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    Me.txtWID.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 0)
    Me.txtWREF.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 1)
    Me.cmbClient.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 2)
    Me.txtSubClient.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 3)
    Me.cmbType.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 4)
    Me.txtLocation.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 5)
    Me.txtDateStart.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 6)
    Me.txtDateEnd.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 7)
    Me.txtS1Start.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 8)
    Me.txtS1End.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 9)
    Me.txtS2Start.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 10)
    Me.txtS2End.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 11)
    Me.txtS3Start.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 12)
    Me.txtS3End.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 13)
    Me.txtQuotedHours.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 14)
    Me.txtActualHours.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 15)
    Me.txtMileage.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 16)
    Me.txtPetrol.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 17)
    Me.txtParking.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 18)
    Me.txtHourly.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 19)
    Me.txtDay.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 20)
    Me.txtSalary.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 21)
    Me.txtTotal.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 22)
    Me.txtIID.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 23)
    Me.cmbPAYE.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 24)
    Me.txtNotes.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 25)
    Me.cmbCountry.Value = Me.lstWorkDatabase.List(Me.lstWorkDatabase.ListIndex, 27)
    
End Sub

'===================================================================================================
'Display Table Contents on Userform Database
'===================================================================================================

Sub Refresh_Data()

    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Work")
    Dim last_Row As Long
    last_Row = Application.WorksheetFunction.CountA(sh.Range("C:C"))
    
    With Me.lstWorkDatabase
        .ColumnHeads = True
        .ColumnCount = 28
        .ColumnWidths = "30,90,80,80,90,100,60,60,40,40,40,40,40,40,50,50,50,50,50,50,50,50,50,60,40,100,100,50"
        
        If last_Row = 1 Then
        .RowSource = "Work!C7:AD7"
        Else
        .RowSource = "Work!C7:AD7" & last_Row
        End If
        
    End With
    
End Sub

'===================================================================================================
'===================================================================================================
'Additional Buttons for Userforms
'===================================================================================================
'New Client
'===================================================================================================

Private Sub btnNewClient_Click()

    frmClient.Show
    
End Sub

'===================================================================================================
'New Job Type
'===================================================================================================

Private Sub btnNewType_Click()

    frmJobType.Show
    
End Sub

'===================================================================================================
'===================================================================================================
'Change of Combo Boxes
'===================================================================================================

Private Sub cmbType_Change()

    Me.cmbType.List = Worksheets("JobType").Range("D7:D50").Value
    
End Sub

Private Sub cmbClient_Change()

    Me.cmbClient.List = Worksheets("Client").Range("E7:E50").Value
    
End Sub

'===================================================================================================

 

[dmt32]

Hi,
not tested but see if this update to the btnAdd_Click procedure does what you want.

Private Sub btnAdd_Click()
    
    Dim Income(1 To 3)  As Currency
    Dim UKSelected      As Boolean
    Dim last_Row        As Long, i As Long
    Dim wsWork          As Worksheet, wsAdmin       As Worksheet
    Dim Prefix          As String, CurrencyFormat   As String, CtrlName As String
    
    With ThisWorkbook
        Set wsWork = .Worksheets("Work")
        Set wsAdmin = .Worksheets("Admin")
    End With
    
    UKSelected = Me.cmbCountry.Value = "UK"
    
    Prefix = IIf(UKSelected, "UK-WREF", "AUS-WREF")
    
    CurrencyFormat = IIf(UKSelected, "$#,##0.00", "[$$-en-AU]#,##0.00")
    
    'income - validate numeric entry & corece text to currency data type
    For i = 1 To 3
        CtrlName = Choose(i, "txtHourly", "txtDay", "txtSalary")
        With Me.Controls(CtrlName)
            If Not IsNumeric(.Value) Then
                MsgBox "Please Enter " & Mid(CtrlName, 4) & " Rate", 48, "Invalid Entry"
                .SetFocus: Exit Sub
            End If
            Income(i) = CCur(.Value)
        End With
    Next i
    
    With wsAdmin
        With .Cells(IIf(UKSelected, 2, 3), 2)
            .Value = .Value + 1
        End With
        .Range("D2").Value = Prefix
        Me.txtWREF = .Range("D1").Value
    End With
    
    last_Row = Application.WorksheetFunction.CountA(wsWork.Range("C:C")) + 1
    
    With wsWork
        .Range("C" & last_Row).Value = "=Row()-6"
        .Range("D" & last_Row).Value = Me.txtWREF.Value
        .Range("E" & last_Row).Value = Me.cmbClient.Value
        .Range("F" & last_Row).Value = Me.txtSubClient.Value
        .Range("G" & last_Row).Value = Me.cmbType.Value
        .Range("H" & last_Row).Value = Me.txtLocation.Value
        .Range("I" & last_Row).Value = Me.txtDateStart.Value
        .Range("J" & last_Row).Value = Me.txtDateEnd.Value
        .Range("K" & last_Row).Value = Me.txtS1Start.Value
        .Range("L" & last_Row).Value = Me.txtS1End.Value
        .Range("M" & last_Row).Value = Me.txtS2Start.Value
        .Range("N" & last_Row).Value = Me.txtS2End.Value
        .Range("O" & last_Row).Value = Me.txtS3Start.Value
        .Range("P" & last_Row).Value = Me.txtS3End.Value
        .Range("Q" & last_Row).Value = Me.txtQuotedHours.Value
        .Range("R" & last_Row).Value = Me.txtActualHours.Value
        .Range("S" & last_Row).Value = Me.txtMileage.Value
        .Range("T" & last_Row).Value = Me.txtPetrol.Value
        .Range("U" & last_Row).Value = Me.txtParking.Value
        
        'income (Columns V W X)
         With .Cells(last_Row, 22).Resize(, 3)
                .Value = Income
                .NumberFormat = CurrencyFormat
        End With

        .Range("Y" & last_Row).Value = Me.txtTotal.Value
        .Range("Z" & last_Row).Value = Me.txtIID.Value
        .Range("AA" & last_Row).Value = Me.cmbPAYE.Value
        .Range("AB" & last_Row).Value = Me.txtNotes.Value
        .Range("AC" & last_Row).Value = Now
        .Range("AD" & last_Row).Value = Me.cmbCountry.Value
    End With
    
    Call btnClear_Click
    Call Refresh_Data
    
End Sub

Dave