Currency symbol change throughout all worksheets

[lkern777]

I have a spreadsheet with 20+ worksheets. Throughout each sheet there are cells formatted for either "Currency" or "Accounting", depending on how I wanted the cell justified.

The cells are currently set to show the USD symbol, but I would like for my users to be able to set the symbol to whatever currency they use the most. I do not need to have any kind of currency conversions.

I have a page that I named "Preferences". On this page, I would like for the user to be able to set the symbol and it change to whatever they select from Excel's options, throughout all pages of the workbook.

Is this possible? I have zero training on VBA, but was thinking that there could be some sort of macro to achieve this.

Any suggestions would be appreciated.

 

[Yongle]

Excel holds every NumberFormat as a string.
The obvious simple search for $ and replace with € does not work (due to a historic legacy!)

Instead both string to replace and replacement string must be specifed
- this is required for both currency and accounting NFs
- to provide the user with a choice of currency requires a table of values for VBA to look up

The practical way to appraoch this is create a list of all required currencies and formats
(column A = currency name , column B = currency-formatted value , column C = accounting-formatted value)
- VBA then takes user preferred currency, looks to list for required formats and replaces default currency & accounting NFs


Suggested method
In the next few posts below I provide a method to get you up and running quickly which you can adapt it to suit yourself
Note - what I have created can handle only one default currency NF and one default accounting NF
If you need it more complicated then you will need to adapt the code after testing

Macro CreateShell adds 4 sheets
You are required to
- format the 2 data sheets with default currency and accounting NFs
- add currencies to sheet "FX"
Macro ApplyUserFormat copies the 2 data sheets and applies user selected currency to those sheets
(duplicating the sheets allows you to test a few things out on data sheets without having to recreate them every time - once converted they stay converted!!)

I will be away from my PC for 3 weeks, and will not be able to test anything should you have any questions. But I will be able to look at the thread in the meantime and will try to answer your questions.

 

[Yongle]

cont.....


Here is the VBA

1. Create a NEW workbook (Do not use an old workbook at this time)

2. (In VBA) add a module and insert both macros in that module

Sub CreateShell()
    Dim ws As Worksheet, d As Integer
'create data sheets
    For d = 1 To 2
        Set ws = Sheets.Add: ws.Name = "Data" & d
            With ws.Columns("A:C")
                .ColumnWidth = 30
                .HorizontalAlignment = xlRight
                .IndentLevel = 2
            End With
            ws.Range("A1:C5") = 999.99
            With ws.Range("A6")
                .Font.Bold = True
                .Formula = "=sum(A1:A5)"
                .AutoFill Destination:=ws.Range("A6:C6"), Type:=xlFillDefault
            End With
    Next
'create sheet "FX"
    Set ws = Sheets.Add:        ws.Name = "FX"
    With ws
        With .Columns("A:C")
            .ColumnWidth = 30
            .HorizontalAlignment = xlRight
            .IndentLevel = 2
        End With
        With .Range("A1:C1")
            .Value = Array("Currency Name (or symbol)", "Currency-Formatted", "Accounting-Formatted")
            .Font.Bold = True
        End With
    
        .Range("B2:C21").Value = 9999.99
        .Range("A2:A4") = WorksheetFunction.Transpose(Array("Default", "£ UK", "Euro"))
        .Range("A3").Select
    End With
'create named range
    ThisWorkbook.Names.Add Name:="CurrencyList", RefersTo:="=OFFSET(FX!$A$2,0,0,COUNTA(FX!$A:$A)-1,1)"
'create sheet "Preferences"
    Set ws = Sheets.Add: ws.Name = "Preferences"
        With ws.Range("A1")
            .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="=CurrencyList"
            .Value = "Default"
        End With
End Sub

Sub ApplyUserFormat()
'------------------------------------------------------------------------
' sheets are copied so that original Data1 and Data2 can be modified and the test run again
    Dim d1 As Worksheet, d2 As Worksheet
    Sheets("Data2").Copy Before:=Sheets(1)
    Sheets("Data1").Copy Before:=Sheets(1)
    Set d1 = Sheets(1)
    Set d2 = Sheets(2)
'-------------------------------------------------------------------------
'replace default currency with user currency
    Const userChoice = "A1"
    Dim UserCurr As Range, UserAcc As Range, UserPref As String
    Dim DefaultCurr As Range, DefaultAcc As Range
    Dim ws As Worksheet, FX As Worksheet, lookWhere As Range, r As Long
    
    Set FX = Sheets("FX")
    Set lookWhere = FX.Range("A:A")
    UserPref = Sheets("Preferences").Range(userChoice).Value
    Set DefaultCurr = FX.Range("B2")
    Set DefaultAcc = FX.Range("C2")
    
'lookup value
    On Error Resume Next
    r = WorksheetFunction.Match(UserPref, lookWhere, 0)
    Set UserCurr = FX.Cells(r, 2)
    Set UserAcc = FX.Cells(r, 3)
    If Err > 0 Then GoTo Handling
    
'replace formats
    For Each ws In ThisWorkbook.Sheets
        If ws.Name <> "Preferences" And ws.Name <> "FX" And ws.Name <> "Data1" And ws.Name <> "Data2" Then
            'replace CURRENCY format:
            Application.FindFormat.NumberFormat = DefaultCurr.NumberFormat
            Application.ReplaceFormat.NumberFormat = UserCurr.NumberFormat
            ws.Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
            
            'replace ACCOUNTING format:
            Application.FindFormat.NumberFormat = DefaultAcc.NumberFormat
            Application.ReplaceFormat.NumberFormat = UserAcc.NumberFormat
            ws.Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
         End If
    Next
    
Exit Sub
    
Handling:
MsgBox "Currency not found?"

End Sub

 

[Yongle]

cont.....

Preparing the workbook for testing

3. (In Excel) run the macro CreateShell
- 4 sheets are created
(if you want to run the macro again at any time, do so in a new workbook)

4. Click on sheet Data1 and format some or all numbers as currency in $ (your default)

5. Click on sheet Data2 and format some or all numbers as accounting in $ (your default)
(mix the formats if you prefer)

6. Click on sheet "FX"
- format cell B2 (the same as currency in data sheets)
- format cell C2 (the same as accounting in data sheets)
VBA will look for above formats to replace

- format cell B3 for currency £ UK
- format cell C3 for accounting £ UK
- format cell B4 for currency Euro
- format cell C4 for accounting Euro

7. Save the file

The file now has enough values to allow testing

 

[Yongle]

cont.....

8. click on sheet "Preferences"
- change value in A1 to Euro
- run macro ApplyUserFormat
- the data sheets have been replicated and their formatting should now be Euro
- click on sheet "Preferences" and change value in A1 to £ UK
- run macro ApplyUserFormat
- the data sheets have been replicated again and their formatting should now be £ UK

9 Delete all replicated sheets (they get in the way!!)

10 Add a few new currencies on sheet FX
(add name in column A and then format the values correctly in B and C for each one)

11. Test that each currency works correctly

12. Finally copy your "genuine" sheets into the workbook and see what happens to those
- those sheets will be converted and you need to copy them in again (or reformat them manually to $) for subsequent testing

 

[lkern777]

Wow! Thank you. I will work on this today. I appreciate your help and such detail.