VBA - Change Currency with drop down box

excelnoob1985

New Member
Joined
Jul 22, 2015
Messages
6
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
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
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)?
 
Upvote 0
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.
 
Upvote 0
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.

Code:
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
 
Upvote 0

Forum statistics

Threads
1,224,551
Messages
6,179,472
Members
452,915
Latest member
hannnahheileen

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top