Select Case - Named Ranges

trux101 · Feb 10, 2016

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

Sub SoSo()
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("A" & rNum).Value
Case "USD"
Range("C" & rNum).Value = Range("B" & rNum) / 1.555
Range("D" & rNum).Value = Range("B" & rNum) * 1.055
Range("E" & rNum).Value = Range("B" & rNum) * 1.015

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

End Select

Next rNum

MsgBox "Completed"

End Sub

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.

Col A = Ccy
Col B = Cost
Col C = Cost_In_GBP
Col D = Commision_1
Col E = Commision_2

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

RickXL · Feb 10, 2016

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?

trux101 · Feb 10, 2016

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!

RickXL · Feb 10, 2016

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

RickXL · Feb 10, 2016

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.

trux101 · Feb 11, 2016

Rick this is amazing and it works perfectly! I've tested the top 3 solutions and below are the seconds each takes to complete. 

50,000 Rows
Solution 1 - 61.2 sec 
Solution 2 - 0.16 sec
Solution 3 – 0.16 sec

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.

Thanks

RickXL · Feb 11, 2016

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

D

E

F

G

H

I

J

K

7

Ccy

Cost

Cost_In_GBP

Commision_1

Commision_2

Ccy

Rate

8

USD

81

56.144988

85.455

82.215

USD

0.693148

9

USD

20

13.86296

21.1

20.3

GBP

1

10

USD

89

61.690172

93.895

90.335

AUD

0.4911

11

USD

60

41.58888

63.3

60.9

EUR

0.784759

12

USD

81

56.144988

85.455

82.215

CAD

0.495372

13

USD

24

16.635552

25.32

24.36

14

USD

34

23.567032

35.87

34.51

15

USD

99

68.621652

104.445

100.485

16

xxx

76

0

80.18

77.14

17

USD

51

35.350548

53.805

51.765

18

USD

64

44.361472

67.52

64.96

19

AUD

98

48.1278

103.39

99.47

20

AUD

47

23.0817

49.585

47.705

21

AUD

15

7.3665

15.825

15.225

22

AUD

74

36.3414

78.07

75.11

23

AUD

2

0.9822

2.11

2.03

24

AUD

78

38.3058

82.29

79.17

25

AUD

52

25.5372

54.86

52.78

26

AUD

56

27.5016

59.08

56.84

27

USD

100

69.3148

105.5

101.5

28

Total

1201

694.527244

1267.055

1219.015

Convert

trux101 · Feb 11, 2016

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.
After manually removing the zero values I now have a runtime error 6

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

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
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("Cost_In_GBP") = Cost_In_GBP
Range("Commision_1") = Commision_1
Range("Commision_2") = Commision_2

End Sub

RickXL · Feb 11, 2016

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

trux101 · Feb 11, 2016

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?

Select Case - Named Ranges

trux101

New Member

RickXL

MrExcel MVP

trux101

New Member

RickXL

MrExcel MVP

RickXL

MrExcel MVP

trux101

New Member

RickXL

MrExcel MVP

trux101

New Member

RickXL

MrExcel MVP

trux101

New Member

Similar threads

Share this page

Select Case - Named Ranges

New Member

MrExcel MVP

New Member

MrExcel MVP

MrExcel MVP

New Member

MrExcel MVP

New Member

MrExcel MVP

New Member

Similar threads

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock