Help with Script code

  • Thread starter Thread starter Frick
  • Start date Start date
F

Frick

Thanks to JE McGimpsey for the script code below that solved a problem
that I had with working with currency rates.

The script works great but I have encountered one problem that is when
I have added some columns and rows which in effect moves the range
from A5:C15 to C9:E14. I changed the range in the script but it
failed to work.

I guess I must be missing something here, so any help would be
appreciated.

Thank you.



Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rateRange As Range
Dim temp As Double
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, Range("A5:C15")) Is Nothing Then
Set rateRange = Range("A2:C2")
Application.EnableEvents = False
temp = .Value / rateRange(.Column)
With Cells(.Row, 1).Resize(1, 3)
Select Case Target.Column
Case 1
.Item(2).Value = temp * rateRange(2)
.Item(3).Value = temp * rateRange(3)
Case 2
.Item(1).Value = temp * rateRange(1)
.Item(3).Value = temp * rateRange(3)
Case Else
.Item(1).Value = temp * rateRange(1)
.Item(2).Value = temp * rateRange(2)
End Select
End With
Application.EnableEvents = True
End If
End With
End Sub
 
This should be a little more robust, as long as sENTRYRANGE and
sRATERANGE have the same number of columns:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sENTRYRANGE As String = "C9:E14"
Const sRATERANGE As String = "C2:E2"
Dim rateArr As Variant
Dim entryArr As Variant
Dim temp As Double
Dim nCol As Integer
Dim startCol As Integer
Dim i As Integer

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, Range(sENTRYRANGE)) _
Is Nothing Then
rateArr = Range(sRATERANGE).Value
startCol = Range(sENTRYRANGE)(1).Column
ReDim entryArr(1 To 1, 1 To UBound(rateArr, 2))
nCol = .Column - startCol + 1
entryArr(1, nCol) = .Value
temp = entryArr(1, nCol) / rateArr(1, nCol)
For i = 1 To UBound(entryArr, 2)
If i <> nCol Then _
entryArr(1, i) = temp * rateArr(1, i)
Next i
Application.EnableEvents = False
Cells(.Row, startCol).Resize( _
1, UBound(entryArr, 2)).Value = entryArr
Application.EnableEvents = True
End If
End With
End Sub


Change sENTRYRANGE or sRATERANGE to suit.
 
The formula works great. Thank you so much for your help.

Quick question.... If I want to add another set of col's (say
F9:h14) using the same RATERANGE C2:E2 can I just duplicate the code
below or must I add to it?

Thanks again for your help
 
The code needs to be modified slightly:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sENTRYRANGE As String = "C9:E14,F9:H14"
Const sRATERANGE As String = "C2:E2"
Dim rateArr As Variant
Dim entryArr As Variant
Dim rArea As Range
Dim temp As Double
Dim nCol As Integer
Dim startCol As Integer
Dim i As Integer

With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, Range(sENTRYRANGE)) _
Is Nothing Then
For Each rArea In Range(sENTRYRANGE).Areas
If Not Intersect(.Cells, rArea) Is Nothing Then
startCol = rArea(1).Column
End If
Next rArea
rateArr = Range(sRATERANGE).Value
ReDim entryArr(1 To 1, 1 To UBound(rateArr, 2))
nCol = .Column - startCol + 1
entryArr(1, nCol) = .Value
temp = entryArr(1, nCol) / rateArr(1, nCol)
For i = 1 To UBound(entryArr, 2)
If i <> nCol Then _
entryArr(1, i) = temp * rateArr(1, i)
Next i
Application.EnableEvents = False
Cells(.Row, startCol).Resize(_
1, UBound(entryArr, 2)).Value = entryArr
Application.EnableEvents = True
End If
End With
End Sub
 
Thaks again for the modification.

However, I am getting a syntax error and the calc stops.

It is in the lines:

Cells(.Row, startCol).Resize(_
1, UBound(entryArr, 2)).Value = entryArr

Both lines are in red.

Can you please further assist in this matter.

Thanks again .

Frick
 
The " _" (i.e., space-underscore) is a continuation character for
the compiler, telling it that the code for that logical line
continues on the next displayed line.

I inadvertently left out a space - put one in between the ( and the
underscore.
 
Back
Top