CODEWITHSUNDEEP
excelvbavbe
Rike
Rike

Reputation: 1

Better way to reference a cell in another worksheet in VBA

Im doing a worksheet in VBA where i need to reference a cell from another worksheet to get a value, is there a better way to do then doing one by one as i am doing in the code bellow.

Sub cotações()


'Moedas tipo A
Dim AED, AFN, ALL, AMD, ANG, AOA, ARS, AWG, BBD, BDT, BGN, BHD, BIF, BMD, BND, BOB, BSD, BTN, BYN, BZD, CAD, CDF, CHF, CLP, CNH As String
Dim CNY, COP, CRC, CUP, CVE, CZK, DJF, DKK, DOP, DZD, EGP, ERN, ETB, GEL, GHS, GMD, GNF, GTQ, GYD, HKD, HNL, HTG, HUF, IDR As String
Dim ILS, INR, IQD, IRR, ISK, JMD, JOD, JPY, KES, KGS, KHR, KMF, KRW, KWD, KYD, KZT, LAK, LBP, LKR, LRD, LSL, LYD, MAD, MDL, MGA, MKD, MMK, MNT, MOP, MRO As String
Dim MRU, MUR, MVR, MWK, MXN, MYR, MZN, NAD, NGN, NIO, NOK, NPR, OMR, PAB, PEN, PHP, PKR, PLN, PYG, QAR, RON, RSD, RUB, RWF, SAR, SCR, SDG As String
Dim SEK, SGD, SLL, SOS, SRD, SSP, STN, SVC, SYP, SZL, THB, TJS, TMT, TND, TRY, TTD, TWD, TZS, UAH, UGX, USD, UYU, UZS, VES, VND, VUV, XAF As String
Dim XCD, XOF, XPF, YER, ZAR, ZMW As String

'Moedas tipo B
Dim AUD, BWP, CLF, COU, EURO, FJD, FKP, GBP, GIP, NZD, PGK, SBD, SHP, TOP, WST, XDR As String


Dim range1, range2, range3, cell As Range

Set range1 = Range("F2:F20000")

    For Each cell In range1
    
        If cell.Value = "AUD" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N29")
            
        ElseIf cell.Value = "BWP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N33")
        
        ElseIf cell.Value = "CLF" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N44")
            
        ElseIf cell.Value = "COU" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N45")
            
        ElseIf cell.Value = "EURO" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N52")
            
        ElseIf cell.Value = "FJD" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N53")
        
        ElseIf cell.Value = "FKP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N83")
        
        ElseIf cell.Value = "GBP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N85")
        
        ElseIf cell.Value = "GIP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N86")
        
        ElseIf cell.Value = "NZD" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N88")
        
        ElseIf cell.Value = "PGK" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N103")
            
        ElseIf cell.Value = "SBD" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N108")
            
        ElseIf cell.Value = "SHP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N114")
            
        ElseIf cell.Value = "TOP" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N119")
            
        ElseIf cell.Value = "WST" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N146")
            
        ElseIf cell.Value = "XDR" Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Worksheets("Cotações").Range("N156")
            
    
    End If
    
    Next
    


End Sub

Upvotes: 0

Views: 50

Answers (1)

taller
taller

Reputation: 18943

Improve code efficiency with

  • minimize the range to loop through
  • loading data from "Cota??es" into dictionary

Please try

    Dim aCur, aRef, Dic As Object, i
    aCur = Split("AUD BWP CLF COU EURO FJD FKP GBP GIP NZD PGK SBD SHP TOP WST XDR")
    aRef = Split("N29 N33 N44 N45 N52 N53 N83 N85 N86 N88 N103 N108 N114 N119 N146 N156")
    For i = 0 To UBound(aCur)
        Dic(aCur(i)) = Worksheets("Cotações").Range(aRef(i)).Value
    Next
    ' Get usedrange of column F
    Set range1 = Application.Intersect(Range("F2:F20000"), ActiveSheet.UsedRange)
    For Each cell In range1
        If Dic.exists(cell.Value) Then
            cell.Offset(0, 2) = cell.Offset(0, 1) * Dic(cell.Value)
        End If
    Next

btw, the code of declares variables should be updated. e.g.

Dim XCD, ZMW As String

'equals

Dim XCD as Variant, ZMW As String

If you want to declare both variables as String, the code is

Dim XCD As String, ZMW As String

Upvotes: 0

Related Questions