Select Case - Named Ranges

[trux101]

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>

 

[RickXL]

I think you have just highlighted one of the advantages of using Tables. Once it knows the name the sheet is not required. Another is that I now need to know your worksheet names to get my code right.

However, I have called my worksheets Test and TestRates. Test has the main data table and TestRates has the smaller currency rate conversion lookup table. (VLOOKUP would have been a shorter way to do this!)

So you will need to overtype those in the code below to make it work for you.
Note all the extra dots in front of the Range commands to link them to the worksheet in the With command.

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 Worksheets("TestRates").Range("FX_Tbl")
        Dic(c.Value) = c.Offset(0, 1).Value
    Next
    
    With Worksheets("Test")
        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 With
End Sub

 

[trux101]

Rick - This works beautifully, it's amazing! Thank you.

 

[RickXL]

Rick - This works beautifully, it's amazing! Thank you.

Good to hear and thanks for the timings you posted earlier, by the way. It is always useful to have a measure of the improvements.

Along the way I improved my knowledge of Tables/ListObjects in VBA so we both got something out of this.

Regards,