Convert a cell or multiple cells from SGD value to USD value based on relevant monthly exchange rate

[ameenuksg]

Hi I want to create a VBA to convert 1 or multiple cells in Sheet 1 to the appropriate value by selecting them in column A and applying the relevant monthly exchange rate from Sheet 2.

Would greatly appreciate any help

Sheet 1	Sheet 1	Sheet 2	Sheet 2
A	B	A	B
Net Sales - $	Sales Date	Feb 2020	0.7543
200	3 Mar 2020	Mar 2020	0.7489
300	4 Apr 2020	Apr 2020	0.7123

 

[ameenuksg]

Not this time, apologies I didnt mentioned this earlier

 

[mse330]

Ok, then try the below revised code

Sub ApplyRate_V2()

Dim a, Rg As Range, c As Range
a = Sheets("Sheet2").[A1].CurrentRegion '<--- change sheet name as needed
Set Rg = Application.InputBox("Select your range", Type:=8) ' Comment this line if you want to make your range fixed
'Set Rg = sheets("Sheet1").range("S1:AB1000") 'Uncomment this line if you comment above line

With CreateObject("scripting.dictionary")
    For x = 3 To UBound(a) '<--- 3 is the 3rd row where your first number of data starts in sheet2
        If Not .exists(a(x, 1)) Then .Add WorksheetFunction.EoMonth(a(x, 1), 0), a(x, 2)
    Next x

    For Each c In Rg.SpecialCells(2)
        If IsNumeric(c.Value) And IsDate(Cells(c.Row, "F").Value) Then
            c.Value = c.Value * .Item(WorksheetFunction.EoMonth(Cells(c.Row, "F").Value, 0))
        End If
    Next
End With

End Sub

 

[ameenuksg]

Although I chose a range once it prompted, but it changed all the numbers in columns B - E & S - AC to 0

 

[ameenuksg]

Should I attach pictures of the sheets here?

 

[mse330]

Is there a period for those ranges in sheet 2 ? A rate for the same month ?

 

[ameenuksg]

Here is a screenshot of sheet 2

 

[mse330]

Ok, just noticed that if you select a single cell it would loop through all cells. Give the below a try

Sub ApplyRate_V2()

Dim a, Rg As Range, c As Range
a = Sheets("Sheet2").[A1].CurrentRegion '<--- change sheet name as needed
Set Rg = Application.InputBox("Select your range", Type:=8) ' Comment this line if you want to make your range fixed
'Set Rg = sheets("Sheet1").range("S1:AB1000") 'Uncomment this line if you comment above line

With CreateObject("scripting.dictionary")
    For x = 3 To UBound(a) '<--- 3 is the 3rd row where your first number of data starts in sheet2
        If Not .exists(a(x, 1)) Then .Add WorksheetFunction.EoMonth(a(x, 1), 0), a(x, 2)
    Next x

    If Rg.Count = 1 And IsNumeric(Rg.Value) And IsDate(Cells(Rg.Row, "F").Value) Then
        Rg.Value = Rg.Value * .Item(WorksheetFunction.EoMonth(Cells(Rg.Row, "F").Value, 0))
    Else
        For Each c In Rg.SpecialCells(2)
             If IsNumeric(c.Value) And IsDate(Cells(c.Row, "F").Value) Then
                c.Value = c.Value * .Item(WorksheetFunction.EoMonth(Cells(c.Row, "F").Value, 0))
            End If
        Next
    End If
End With

End Sub

 

[ameenuksg]

its working wonders now?? one last request? once it changes, it adds four additional decimals like this 2233.206558, can help to adjust VBA to shorten to two decimals instead

 

[mse330]

Glad it is working fine now … I have added Round function in the code as shown below

Sub ApplyRate_V2()

Dim a, Rg As Range, c As Range
a = Sheets("Sheet2").[A1].CurrentRegion '<--- change sheet name as needed
Set Rg = Application.InputBox("Select your range", Type:=8) ' Comment this line if you want to make your range fixed
'Set Rg = sheets("Sheet1").range("S1:AB1000") 'Uncomment this line if you comment above line

With CreateObject("scripting.dictionary")
    For x = 3 To UBound(a) '<--- 3 is the 3rd row where your first number of data starts in sheet2
        If Not .exists(a(x, 1)) Then .Add WorksheetFunction.EoMonth(a(x, 1), 0), a(x, 2)
    Next x

    If Rg.Count = 1 And IsNumeric(Rg.Value) And IsDate(Cells(Rg.Row, "F").Value) Then
        Rg.Value = Round(Rg.Value * .Item(WorksheetFunction.EoMonth(Cells(Rg.Row, "F").Value, 0)), 2)
    Else
        For Each c In Rg.SpecialCells(2)
             If IsNumeric(c.Value) And IsDate(Cells(c.Row, "F").Value) Then
                c.Value = Round(c.Value * .Item(WorksheetFunction.EoMonth(Cells(c.Row, "F").Value, 0)), 2)
            End If
        Next
    End If
End With

End Sub

 

[ameenuksg]

Sweet!? can't thank you enough, have a great week ahead !?