VBA - Change Currency with drop down box

[excelnoob1985]

Hi all,

I have implemented some VBA script so that when I change the type of currency in a drop down box on a sheet called "Data Sheet", all currency cells only in the rest of the workbook will change to reflect the new type of currency selected.

This works fine for most of the sheets where there are only a few currency cells where I have managed to restricted the script cover a selection of cells. However for one of my sheets called "Fees", there are thousands of cells, which are not all together, to change. I have implemented the following code (this is only part of it as it is repeated in the VBA script to cover all 12 currencies in the drop down box) but it takes anywhere between 5 - 10 seconds to run each time I change the currency.

Is there anyway that I can improve it to make it run faster (I have highlighted the section of the code that I think is causing the slow running).

Thank you!

--------------------------

If Target.Address = "$G$1" Then
If Target.Value = "GBP" Then Sheets("MatterTeam&ApplicableRates").Range("D20:D118").NumberFormat = "£#,##0.00"
If Target.Value = "GBP" Then Sheets("Disbursements").Range("E:E").NumberFormat = "£#,##0.00"
If Target.Value = "GBP" Then Sheets("Monthly Profiling Data").Range("B8:B27,E8:CB29,B41:B60,E41:CB62").NumberFormat = "£#,##0.00"
If Target.Value = "GBP" Then Sheets("Monthly Costs").Range("C13:E106").NumberFormat = "£#,##0.00"
If Target.Value = "GBP" Then
For Each c In Sheets("Fees").Range("A1:GZ111").Cells
If c.NumberFormat = "£#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "€#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$$-409]#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$AED] #,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$A$]#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$TRY] #,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "¥#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$HK$]#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$S$]#,##0.00" Then c.NumberFormat = "£#,##0.00"
If c.NumberFormat = "[$FK£]#,##0.00" Then c.NumberFormat = "£#,##0.00"
Next
End If

If Target.Address = "$G$1" Then
If Target.Value = "EUR" Then Sheets("MatterTeam&ApplicableRates").Range("D20:D118").NumberFormat = "€#,##0.00"
If Target.Value = "EUR" Then Sheets("Disbursements").Range("E:E").NumberFormat = "€#,##0.00"
If Target.Value = "EUR" Then Sheets("Monthly Profiling Data").Range("B8:B27,E8:CB29,B41:B60,E41:CB62").NumberFormat = "€#,##0.00"
If Target.Value = "EUR" Then Sheets("Monthly Costs").Range("C13:E106").NumberFormat = "€#,##0.00"
If Target.Value = "EUR" Then
For Each c In Sheets("Fees").Range("A1:GZ111").Cells
If c.NumberFormat = "£#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "€#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$$-409]#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$AED] #,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$A$]#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$TRY] #,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "¥#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$HK$]#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$S$]#,##0.00" Then c.NumberFormat = "€#,##0.00"
If c.NumberFormat = "[$FK£]#,##0.00" Then c.NumberFormat = "€#,##0.00"
Next
End If

 

[njimack]

I'd suggest using Select Case rather than numerous If/Then statements. Also, do you need to test every single cell in A1:GZ111, or could you use SpecialCells to limit it just to cells containing formulae (for example)?

 

[excelnoob1985]

Njimack - how would I change the code to implement 'Select Case' please? Whilst I managed to cobble the above together, I'm not all that familiar with the different functions of VBA. An example with my code would be much appreciated.

As to checking every cell, it is definitely not necessary. You are right in that only cells with a formula need to be changed. Again, an example of how this might be done would be most gratefully received. The reason I selected the range as is is that by selecting individual ranges for groups of cells that needed to be changed, I ended up with close to 200 different ranges which kept bringing up an error whenever I tried to change the currency - I imagine there is a limit to the number of references one can have.

 

[njimack]

OK, this almost certainly won't work but should give you an idea of the structure, and it should run faster than your existing code, plus be easier it maintain.

Private Sub Worksheet_Change(ByVal Target As Range)


Dim CCY As String
Dim c As Range


If Target.Address <> "$G$1" Then Exit Sub


With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With


Select Case Target.Value


Case "EUR": CCY = "€"
Case "GBP": CCY = "£"


End Select


Sheets("MatterTeam&ApplicableRates").Range("D20:D118").NumberFormat = CCY & "#,##0.00"
Sheets("Disbursements").Range("E:E").NumberFormat = CCY & "#,##0.00"
Sheets("Monthly Profiling Data").Range("B8:B27,E8:CB29,B41:B60,E41:CB62").NumberFormat = CCY & "#,##0.00"
Sheets("Monthly Costs").Range("C13:E106").NumberFormat = CCY & "#,##0.00"




For Each c In Sheets("Fees").Range("A1:GZ111").SpecialCells(xlCellTypeFormulas)
    Select Case Target.Value
    
    Case "EUR"
        c.NumberFormat = Replace(c.NumberFormat, "£", CCY)
        
    Case "GBP"
        c.NumberFormat = Replace(c.NumberFormat, "€", CCY)
        
    End Select
    
    c.NumberFormat = Replace(c.NumberFormat, "[$$-409]", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "[$AED] ", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "[$A$] ", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "[$TRY]", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "¥", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "[$HK$]", CCY)
    c.NumberFormat = Replace(c.NumberFormat, "[$FK£]", CCY)


Next c


With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With






End Sub