Select Case - Named Ranges

trux101

New Member
Joined
Feb 10, 2016
Messages
19
I have a spreadsheet that contains currency name in col A e.g. USD, AUD etc. Col B contains the amount that needs to be converted into GBP. The calculations will happen in the VBA code below and results stored in col C, D and E</SPAN>


Sub SoSo()</SPAN></SPAN>
Dim Rng As Range</SPAN></SPAN>
Dim rNum As Long</SPAN></SPAN>
Dim LRow As Long</SPAN></SPAN>
LRow = Range("Ccy").Rows.Count</SPAN></SPAN>

For rNum = 1 To LRow + 1</SPAN></SPAN>

Select Case Range("A" & rNum).Value</SPAN></SPAN>
Case "USD"</SPAN></SPAN>
Range("C" & rNum).Value = Range("B" & rNum) / 1.555</SPAN></SPAN>
Range("D" & rNum).Value = Range("B" & rNum) * 1.055</SPAN></SPAN>
Range("E" & rNum).Value = Range("B" & rNum) * 1.015</SPAN></SPAN>

Case "AUD"</SPAN></SPAN>
Range("C" & rNum).Value = Range("B" & rNum) / 2.015</SPAN></SPAN>
Range("D" & rNum).Value = Range("B" & rNum) * 1.055</SPAN></SPAN>
Range("E" & rNum).Value = Range("B" & rNum) * 1.015</SPAN></SPAN>

End Select</SPAN></SPAN>

Next rNum</SPAN></SPAN>

MsgBox "Completed"</SPAN></SPAN>

End Sub</SPAN></SPAN>

The overall spreadsheet will contain about 90,000 rows of data that will need the same procedure to take place. It’s preferable to use named ranges as below instead of col A, B etc.</SPAN>

  • Col A = Ccy</SPAN>
  • Col B = Cost</SPAN></SPAN>
  • Col C = Cost_In_GBP</SPAN></SPAN>
  • Col D = Commision_1</SPAN></SPAN>
  • Col E = Commision_2</SPAN></SPAN>

Questions</SPAN>
Is there a method of using the named ranges for this procedure, currently using the above named ranges is breaking the code?</SPAN>
Is there a method of increasing its efficiency and speed of execution, currently it’s taking several minutes?</SPAN>
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Hi and welcome to the MrExcel Message Board.

You could use named ranges but if you want to improve execution speed then there is another way.

VBA is slow if it has to keep reading and writing to the worksheet. The way to speed it up is to read everything in one go then write it all back in one go. Basically, you just transfer the column data into a VBA array.

However I have a question. The commissions seem to be calculated as a percentage of the original currency and not as a percentage of the GBP value. Is that intentional?
 
Upvote 0
Thank you for the reply RickXL

I'm very new to VBA not sure how that code can be altered to make it work with named ranges. The commission has other calculations to it and you're correct afterwards will also need to be converted to GBP - but I removed those extra elements to make it clearer on the issue I have with the code. Look forward to your feedback!
 
Upvote 0
Hi,

I am more of a VBA person than a worksheet one so I have to say that Named Ranges are not something I would choose to use. You need to make them dynamic before they are very useful. I would probably use a Table instead.

However, if you want to use a named Range then I think this works:
Code:
Sub SoSoRange()
    Dim Rng As Range
    Dim rNum As Long
    Dim LRow As Long
    LRow = Range("Ccy").Rows.Count
    
    For rNum = 1 To LRow + 1
    
        Select Case Range("Ccy")(rNum, 1).Value
            Case "USD"
                Range("Cost_In_GBP")(rNum, 1).Value = Range("Cost")(rNum, 1) / 1.555
                Range("Commision_1")(rNum, 1).Value = Range("Cost")(rNum, 1) * 1.055
                Range("Commision_2")(rNum, 1).Value = Range("Cost")(rNum, 1) * 1.015
            
            Case "AUD"
                Range("Cost_In_GBP")(rNum, 1).Value = Range("Cost")(rNum, 1) / 2.015
                Range("Commision_1")(rNum, 1).Value = Range("Cost")(rNum, 1) * 1.055
                Range("Commision_2")(rNum, 1).Value = Range("Cost")(rNum, 1) * 1.015
        
        End Select
    
    Next rNum
    
    MsgBox "Completed"

End Sub

If you want it to run quicker then you could use this which still relied on named Ranges:
Code:
Sub SoSoArray()
    Dim Rng As Range
    Dim rNum As Long
    Dim LRow As Long
    Dim Ccy As Variant
    Dim Cost As Variant
    Dim Cost_In_GBP As Variant
    Dim Commision_1 As Variant
    Dim Commision_2 As Variant
    
    LRow = Range("Ccy").Rows.Count
    Ccy = Range("Ccy")
    Cost = Range("Cost")
    ReDim Cost_In_GBP(1 To LRow, 1 To 1)
    ReDim Commision_1(1 To LRow, 1 To 1)
    ReDim Commision_2(1 To LRow, 1 To 1)
    
    For rNum = 1 To LRow
    
        Select Case Ccy(rNum, 1)
            Case "USD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 1.555
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
            
            Case "AUD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 2.015
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
        
        End Select
    
    Next rNum
    
    Range("Cost_In_GBP") = Cost_In_GBP
    Range("Commision_1") = Commision_1
    Range("Commision_2") = Commision_2
    
    MsgBox "Completed"

End Sub
My personal choice would be to not use Named Ranges so I would probably use something like this:
Code:
Sub SoSoArray2()

    Dim rNum            As Long
    Dim LRow            As Long
    Dim Ccy             As Variant
    Dim Cost            As Variant
    Dim Cost_In_GBP     As Variant
    Dim Commision_1     As Variant
    Dim Commision_2     As Variant
    
    LRow = Cells(Rows.Count, "A").End(xlUp).Row
    Ccy = Range("A2:A" & LRow)
    Cost = Range("B2:B" & LRow)
    ReDim Cost_In_GBP(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_1(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_2(1 To UBound(Ccy), 1 To 1)
    
    For rNum = 1 To UBound(Ccy)
    
        Select Case Ccy(rNum, 1)
            Case "USD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 1.555
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
            
            Case "AUD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 2.015
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
        
        End Select
    
    Next rNum
    
    Range("C2").Resize(UBound(Cost_In_GBP), 1) = Cost_In_GBP
    Range("D2").Resize(UBound(Cost_In_GBP), 1) = Commision_1
    Range("E2").Resize(UBound(Cost_In_GBP), 1) = Commision_2
    
    MsgBox "Completed"

End Sub
 
Last edited:
Upvote 0
If you choose to use a Table then the following code will work for the current worksheet.

To change your data to a table just select a cell in the data and hit Ctrl + T then confirm the range.

I renamed my table to CcyTable - it defaulted to Table1.

Code:
Sub SoSoTable2()
    Dim rNum            As Long
    Dim Ccy             As Variant
    Dim Cost            As Variant
    Dim Cost_In_GBP     As Variant
    Dim Commision_1     As Variant
    Dim Commision_2     As Variant
    
    Ccy = Range("CcyTable[Ccy]")
    Cost = Range("CcyTable[Cost]")
    ReDim Cost_In_GBP(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_1(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_2(1 To UBound(Ccy), 1 To 1)
    
    For rNum = 1 To UBound(Ccy)
        Select Case Ccy(rNum, 1)
            Case "USD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 1.555
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
            Case "AUD"
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / 2.015
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
        End Select
    Next rNum
    
    Range("CcyTable[Cost_In_GBP]") = Cost_In_GBP
    Range("CcyTable[Commision_1]") = Commision_1
    Range("CcyTable[Commision_2]") = Commision_2
    
    MsgBox "Completed"

End Sub
Using Tables has some advantages:
1. You can insert extra lines in front or on top of the table and the code does not need changing.
2. Any formulas in the table will automatically be copied down when entered.
3. You can add a totals row without requiring a change in the code.
4. You can use table name and column headings everywhere in the code.
5. No Named Ranges required.
6. You can add rows and the table will automatically expand. No code changes necessary.
7. I think it improves the readability of the code.
8. The Variant Arrays can be directly assigned to the column without having to count rows and subtract start rows etc.
 
Upvote 0
Rick this is amazing and it works perfectly! I've tested the top 3 solutions and below are the seconds each takes to complete. </SPAN>

50,000 Rows</SPAN>
Solution 1 - 61.2 sec </SPAN></SPAN>
Solution 2 - 0.16 sec</SPAN></SPAN>
Solution 3 – 0.16 sec</SPAN></SPAN>

Now suppose I wanted to have the exchange rates in the excel sheet range rather than hardcoded as it is currently, what adjustment would I need to solution 2 (the one using named ranges) to make it work? By having them hardcoded as I do means each time the FX rates change I have to go into my code to ammend.</SPAN></SPAN>

Thanks</SPAN></SPAN>
 
Upvote 0
Where would you like to put your list of exchange rates?

On the same worksheet or on a different one?

Also, which coding solution do you want to go with?

I just added a Table with exchange rates to the worksheet with the data and it worked out quite easily. I called the new Table "Rates":
Code:
Sub SoSoTable3()
    Dim rNum            As Long
    Dim Ccy             As Variant
    Dim Cost            As Variant
    Dim Cost_In_GBP     As Variant
    Dim Commision_1     As Variant
    Dim Commision_2     As Variant
    Dim Dic             As Object
    Dim c               As Range
    
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each c In Range("Rates[Ccy]")
        Dic(c.Value) = c.Offset(0, 1).Value
    Next
    
    Ccy = Range("CcyTable[Ccy]")
    Cost = Range("CcyTable[Cost]")
    ReDim Cost_In_GBP(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_1(1 To UBound(Ccy), 1 To 1)
    ReDim Commision_2(1 To UBound(Ccy), 1 To 1)
    
    For rNum = 1 To UBound(Ccy)
        Cost_In_GBP(rNum, 1) = Cost(rNum, 1) * Dic(Ccy(rNum, 1))
        Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
        Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
    Next rNum
    
    Range("CcyTable[Cost_In_GBP]") = Cost_In_GBP
    Range("CcyTable[Commision_1]") = Commision_1
    Range("CcyTable[Commision_2]") = Commision_2
    
    MsgBox "Completed"

End Sub

Excel 2013
DEFGHIJK
7CcyCostCost_In_GBPCommision_1Commision_2CcyRate
8USD8156.14498885.45582.215USD0.693148
9USD2013.8629621.120.3GBP1
10USD8961.69017293.89590.335AUD0.4911
11USD6041.5888863.360.9EUR0.784759
12USD8156.14498885.45582.215CAD0.495372
13USD2416.63555225.3224.36
14USD3423.56703235.8734.51
15USD9968.621652104.445100.485
16xxx76080.1877.14
17USD5135.35054853.80551.765
18USD6444.36147267.5264.96
19AUD9848.1278103.3999.47
20AUD4723.081749.58547.705
21AUD157.366515.82515.225
22AUD7436.341478.0775.11
23AUD20.98222.112.03
24AUD7838.305882.2979.17
25AUD5225.537254.8652.78
26AUD5627.501659.0856.84
27USD10069.3148105.5101.5
28Total1201694.5272441267.0551219.015
Convert
 
Upvote 0
  1. Using solution 2 – initially with the code below I was getting a runtime error 11 – divide by zero and so I deleted the zeros but in reality the zeros will be a regular occurrence so I need to figure some sort of error handler that replaces zero or blank Ccy with GBP and zero or blank Cost with 1. </SPAN></SPAN></SPAN>
  2. After manually removing the zero values I now have a runtime error 6</SPAN></SPAN></SPAN>


I’ve spent the last 2 hours trying to work this out with no luck! Where am I going wrong with this?</SPAN></SPAN>


Sub SoSoArray2 ()</SPAN></SPAN>
Dim Rng As Range</SPAN></SPAN>
Dim rNum As Long</SPAN></SPAN>
Dim LRow As Long</SPAN></SPAN>
Dim Ccy As Variant</SPAN></SPAN>
Dim Cost As Variant</SPAN></SPAN>
Dim Cost_In_GBP As Variant</SPAN></SPAN>
Dim Commision_1 As Variant</SPAN></SPAN>
Dim Commision_2 As Variant</SPAN></SPAN>
Dim Dic As Object</SPAN></SPAN>
Dim c As Range</SPAN></SPAN>

Set Dic = CreateObject("Scripting.Dictionary")</SPAN></SPAN>
For Each c In Range("FX_Tbl")</SPAN></SPAN>
Dic(c.Value) = c.Offset(0, 1).Value</SPAN></SPAN>
Next</SPAN></SPAN>

LRow = Range("Ccy").Rows.Count</SPAN></SPAN>
Ccy = Range("Ccy")</SPAN></SPAN>
Cost = Range("Cost")</SPAN></SPAN>

ReDim Cost_In_GBP(1 To LRow, 1 To 1)</SPAN></SPAN>
ReDim Commision_1(1 To LRow, 1 To 1)</SPAN></SPAN>
ReDim Commision_2(1 To LRow, 1 To 1)</SPAN></SPAN>

For rNum = 1 To LRow</SPAN></SPAN>
Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / Dic(Ccy(rNum, 1))</SPAN></SPAN>
Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055</SPAN></SPAN>
Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015</SPAN></SPAN>
Next rNum</SPAN></SPAN>

Range("Cost_In_GBP") = Cost_In_GBP</SPAN></SPAN>
Range("Commision_1") = Commision_1</SPAN></SPAN>
Range("Commision_2") = Commision_2</SPAN></SPAN>

End Sub</SPAN></SPAN>
 
Upvote 0
When I run your code it ran until it found my "xxx" currency then returned a Divide By Zero error.

Your previous code had a multiplication sign there so there was no problem. Could you use the reciprocal of the exchange rate as before?

Alternatively:
Code:
Sub SoSoArray2()
    Dim Rng             As Range
    Dim rNum            As Long
    Dim LRow            As Long
    Dim Ccy             As Variant
    Dim Cost            As Variant
    Dim Cost_In_GBP     As Variant
    Dim Commision_1     As Variant
    Dim Commision_2     As Variant
    Dim Dic             As Object
    Dim c               As Range
    
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each c In Range("FX_Tbl")
        Dic(c.Value) = c.Offset(0, 1).Value
    Next
    
    LRow = Range("Ccy").Rows.Count
    Ccy = Range("Ccy")
    Cost = Range("Cost")
    
    ReDim Cost_In_GBP(1 To LRow, 1 To 1)
    ReDim Commision_1(1 To LRow, 1 To 1)
    ReDim Commision_2(1 To LRow, 1 To 1)
    
    For rNum = 1 To LRow
        If Dic.Exists(Ccy(rNum, 1)) Then
            If Dic(Ccy(rNum, 1)) <> 0 Then
                Cost_In_GBP(rNum, 1) = Cost(rNum, 1) / Dic(Ccy(rNum, 1))
                Commision_1(rNum, 1) = Cost(rNum, 1) * 1.055
                Commision_2(rNum, 1) = Cost(rNum, 1) * 1.015
            End If
        End If
    Next rNum
    
    Range("Cost_In_GBP") = Cost_In_GBP
    Range("Commision_1") = Commision_1
    Range("Commision_2") = Commision_2

End Sub
 
Upvote 0
Rick I really appreciate this! One final thing - the program runs perfectly if the FX_Tbl is on the same sheet. What tweak is needed to get it to run on whatever worksheet the FX_Tbl is stored on?
 
Upvote 0

Forum statistics

Threads
1,213,554
Messages
6,114,280
Members
448,562
Latest member
Flashbond

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