Help with VB Script Code

  • Thread starter Thread starter Scott Frickman
  • Start date Start date
S

Scott Frickman

I have a worksheet that allows me to enter an amount and then based on some
VB code 2 other col's are propogated with numbers based on the first number
entered. What it does is when I enter a currency in 1 col (US $) the other
col's provide the amount based on the exchange rates entered for the other
two cols.

What I would like to be able to do is to have the number that is entered
first in one color and the numbers that are propogated in another color.
Bear in mind that with the VB Script I can enter the input number in any one
of the three Col's.

Here is the script that I am using:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sENTRYRANGE As String = "D9:F1500,G9:I1500,J9:L1500"
Const sRATERANGE As String = "D1:F1"
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

I suspect that there is probably some value that I just need to insert into
the above script but I am not sure what it should be.

Any help here would be greatly appreciated.

Frick
 
Scott,

What is in D1:F1, and what is in D5:F1500 (& G9:I1500, J9:L1500)? Where are
the exchange rates?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Bob,

D1:F1 is the Rate Range. Each cell as an exchange rate in it, i.e.
US=$1.00 Euro=0.80 etc

D5:F1500 is where I enter an amount, i.e. col D = US Dollar amount, col
E=Euro Dollar amount etc

In effect when I enter an amount, for example in cell D5 US Dollar amount =
$1.00, then in cols E the script would return the Euro amount = to USD 1.00
and col F would return the value based on that currency.

Frick
 
Frick,

Give this a whirl.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Const sENTRYRANGE As String = "D9:F1500,G9:I1500,J9:L1500"
Const sRATERANGE As String = "D1:F1"
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
With Cells(.Row, startCol).Resize(1, UBound(entryArr, 2))
.Value = entryArr
.Font.ColorIndex = xlColorIndexAutomatic
.Font.Bold = False
End With
With Target
.Font.ColorIndex = 3
.Font.Bold = True
End With
Application.EnableEvents = True
End If
End With
End Sub




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)
 
Back
Top