Replace Formats Across ALL SHEETS in Workbook

[cubsfan05]

Sub ChangeCurrency()' ChangeCurrency Macro
' Programmed by Lucas on 10/31/16


    Dim NewCurrency, OldCurrency As String
    NewCurrency = Range("currency_flag").Value
    OldCurrency = "USD"
    
    Sheets.Select
        
    Select Case OldCurrency & "_" & NewCurrency
        Case "USD_GBP"
            Call USD_GBP
        Case Else
            MsgBox "Selected currency must be changed manually.", 0, "Error: Select a Different Currency"
    End Select
    
End Sub
Sub USD_GBP()


    'accounting w/o decimals
    Application.FindFormat.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
    Application.ReplaceFormat.NumberFormat = "_-[$£-809]* #,##0_-;-[$£-809]* #,##0_-;_-[$£-809]* ""-""_-;_-@_-"
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    'accounting w/ decimals
    Application.FindFormat.NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
    Application.ReplaceFormat.NumberFormat = "_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    'currency w/ decimals
    Application.FindFormat.NumberFormat = "$#,##0.00_);($#,##0.00)"
    Application.ReplaceFormat.NumberFormat = "[$£-809]#,##0.00;-[$£-809]#,##0.00"
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    'currency w/o decimals
    Application.FindFormat.NumberFormat = "$#,##0_);($#,##0)"
    Application.ReplaceFormat.NumberFormat = "[$£-809]#,##0"
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
    
    'currency in text formulae
    Cells.Replace What:=",""$", Replacement:=",""£", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True


End Sub

I wrote the above code to replace all USD formats with GBP formats (the USD_GBP sub does this)
However, I'm wondering what's the most efficient way to make this change across all sheets in the workbook.
I've tried sheets.select but it says "Method of Object Sheets Failed"
Also considered a for loop as in for each ws in activeworkbook.sheets call the sub and then next ws
but that seems inefficient

less important but also would appreciate any ideas on efficiently changing between currencies. i'm thinking right now to change from say GBP to EUR i'd have to reset the currency to dollars and then set the currencies to EUR.
The currencies I'll have are CAD, EUR, GBP, USD, maybe one or two others, seems a huge number of subs to program each switch

Appreciate the help

 

[pgc01]

Hi

Not sure I understood

You mean

- you have all the worksheets in your book using 1 currency format (for ex. CAD)
- you want to change that format to another currency (for ex. to EUR)

If that is the case you just have to
- create a style with the format
- format all those cells with the style

If you change the style, automatically all the cells in all the worksheets that use that style will update.

Please comment.

 

[cubsfan05]

Effectively yes, I was initially having trouble selecting all sheets (as the line Sheets.Select wasn't working for some reason)
but I'm now having an issue with the " Application.ReplaceFormat.NumberFormat = ReplaceNew" line
it's returning null which i would think is because the format is invalid, however the format is copied and pasted from recording a portion of the macro

Sub ChangeCurrency()' ChangeCurrency Macro
' Programmed by Lucas Weiss on 10/31/16


    Dim NewCurrency, OldCurrency As String
    Dim find1 As String, find2 As String, find3 As String, find4 As String, find5 As String
    Dim replace1 As String, replace2 As String, replace3 As String, replace4 As String, replace5 As String
    Dim ws As Worksheet
    
    
    NewCurrency = Range("currency_flag").Value
    OldCurrency = "USD"
    
    'Sheets.Select
        
    Select Case OldCurrency
        Case "USD"
            find1 = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"  'accounting w/o decimals
            find2 = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"  'accounting w/ decimals
            find3 = "$#,##0.00_);($#,##0.00)" 'currency w decimals
            find4 = "$#,##0_);($#,##0)"  'currency w/o decimals
            find5 = ",""$"  'in text formulas
        Case Else
            MsgBox "Existing currency must be changed manually.", 0, "Error: Change Currency Manually"
    End Select
    
    Select Case NewCurrency
        Case "GBP"
            replace1 = "_-[$£-809]* #,##0_-;-[$£-809]* #,##0_-;_-[$£-809]* ""-""_-;_-@_-"  'accounting w/o decimals
            replace2 = "_-[$£-809]* #,##0.00_-;-[$£-809]* #,##0.00_-;_-[$£-809]* ""-""??_-;_-@_-"  'accounting w/ decimals
            replace3 = "[$£-809]#,##0.00;-[$£-809]#,##0.00"  'currency w decimals
            replace4 = "[$£-809]#,##0"  'currency w/o decimals
            replace5 = ",""£"  'in text formulas
        Case Else
            MsgBox "Selected currency must be changed manually.", 0, "Error:Select a Different Currency"
    End Select
    
    For Each ws In ActiveWorkbook.Sheets
        Call FindReplaceCurrency(find1, replace1)
        Call FindReplaceCurrency(find2, replace2)
        Call FindReplaceCurrency(find3, replace3)
        Call FindReplaceCurrency(find4, replace4)
        Cells.Replace What:=find5, Replacement:=replace5, LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=True
    Next ws
    
    
End Sub


'--------------------------------------------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------------------------------------------
Sub FindReplaceCurrency(FindOld As String, ReplaceNew As String)
    Application.FindFormat.Clear
    Application.FindFormat.NumberFormat = FindOld
    Application.ReplaceFormat.Clear
    Application.ReplaceFormat.NumberFormat = ReplaceNew
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End Sub

 

[Legacy 393636]

Hi cubsfan05,

Did you have any luck with this? I've searched the forums, but I don't really know VBA so I'm struggling to put it together.

My Goal: To have a cell where you enter/select a currency (USD,EUR,GBP etc.) that then changes all currency cells in a workbook to that currency automatically.


Currently I found this on the forum to change cells (A15:C15) to a particular currency format based on the input to 'C12':

Private Sub Worksheet_Change(ByVal Target As Range)
 If Intersect(Target, Me.Range("C12")) Is Nothing Then Exit Sub
 On Error GoTo endit
       Application.EnableEvents = False
 With Me.Range("A15:C15")
 Select Case Target.Value
    Case "USD"
        .NumberFormat = "[$$-en-US]* #,##0.00;[Red]-([$$-en-US]* #,##0.00);"
    Case "GBP"
        .NumberFormat = "[$£-en-GB]* #,##0.00;[Red]-([$£-en-GB]* #,##0.00);"
    Case "EUR"
        .NumberFormat = "[$€-x-euro2] * #,##0.00;[Red]-([$€-x-euro2] * #,##0.00);"
     End Select
End With
endit:
     Application.EnableEvents = True
End Sub

Now I am struggling to find VBA code that would allow me to select all cells in the workbook (instead of just A15:C15) if they are currency/accounting formatted, which from my understanding you have above.


Cheers!