I have generated the script below that will take three differenct currency
exchange rates located in Cells D1:F1 and based on a target cell input will
then convert the remaining adjoining cells into the adjusted currencys. The
script works well and the target cell when inputted the text turns red while
the adjoining cells text is black.

My problem is that if I change any of the currency rates in Cells D1:F1,
none of the target cells update. I auapect I need to enter some script that
will allow updating but I am at a loss as to what the script should be.
Obviously, it is not a recalc as there are no formula in the range cells.

Can someone please assist here? Thank you for any help offered.

Frick

Example:

D1:F1 1.00 0.81 1.71

Target Cells D9:F1500 1.23 1.00 2.11 (where the input
cell was E9 @1.00)


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

Frick

well, I understand the problem ... but not a solution

when you input data into the Input Range (D9:F1500,G9:I1500,J9:L1500) the
Worksheet_Change event calculates the values and puts them in the cells ...
note: VALUES not formulae. Hence if you change the rates there is no
adjustment to the values previously calculated. Currently, if Range D1 to
F1 is amended this will be excluded from the Change event.

So, a couple of options: 1) put formulae in the cells adjacent to the input
cell or 2) in the Change event check for a change in cells D1 to F1 and
force a recalculation of the cells in the Input Range.

You could use code on Chip Pearson's site to identify the cells with the red
font and use those as the input to the recalculation.

Regards

Trevor


"Frick" wrote in message
...
I have generated the script below that will take three differenct currency
exchange rates located in Cells D1:F1 and based on a target cell input
will
then convert the remaining adjoining cells into the adjusted currencys.
The
script works well and the target cell when inputted the text turns red
while
the adjoining cells text is black.

My problem is that if I change any of the currency rates in Cells D1:F1,
none of the target cells update. I auapect I need to enter some script
that
will allow updating but I am at a loss as to what the script should be.
Obviously, it is not a recalc as there are no formula in the range cells.

Can someone please assist here? Thank you for any help offered.

Frick

Example:

D1:F1 1.00 0.81 1.71

Target Cells D9:F1500 1.23 1.00 2.11 (where the
input
cell was E9 @1.00)


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

Frick,

Cracked it - harder than I anticipated, but the solution was easy when I
thought laterally.

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
ElseIf Not Intersect(target, Range(sRATERANGE)) _
Is Nothing Then
UpdatedRates target
End If
End With
End Sub


Private Sub UpdatedRates(target As Range)
Dim i As Long, j As Long

For i = 9 To Range("D1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 3 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To Range("G1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 6 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To Range("J1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 9 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

End Sub


--

HTH

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

"Frick" wrote in message
...
I have generated the script below that will take three differenct currency
exchange rates located in Cells D1:F1 and based on a target cell input
will
then convert the remaining adjoining cells into the adjusted currencys.
The
script works well and the target cell when inputted the text turns red
while
the adjoining cells text is black.

My problem is that if I change any of the currency rates in Cells D1:F1,
none of the target cells update. I auapect I need to enter some script
that
will allow updating but I am at a loss as to what the script should be.
Obviously, it is not a recalc as there are no formula in the range cells.

Can someone please assist here? Thank you for any help offered.

Frick

Example:

D1:F1 1.00 0.81 1.71

Target Cells D9:F1500 1.23 1.00 2.11 (where the
input
cell was E9 @1.00)


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

Neat ... and just within two hours ... impressive !


"Bob Phillips" wrote in message
...
Frick,

Cracked it - harder than I anticipated, but the solution was easy when I
thought laterally.

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
ElseIf Not Intersect(target, Range(sRATERANGE)) _
Is Nothing Then
UpdatedRates target
End If
End With
End Sub


Private Sub UpdatedRates(target As Range)
Dim i As Long, j As Long

For i = 9 To Range("D1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 3 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To Range("G1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 6 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To Range("J1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With Cells(i, 9 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

End Sub


--

HTH

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

"Frick" wrote in message
...
I have generated the script below that will take three differenct
currency
exchange rates located in Cells D1:F1 and based on a target cell input
will
then convert the remaining adjoining cells into the adjusted currencys.
The
script works well and the target cell when inputted the text turns red
while
the adjoining cells text is black.

My problem is that if I change any of the currency rates in Cells D1:F1,
none of the target cells update. I auapect I need to enter some script
that
will allow updating but I am at a loss as to what the script should be.
Obviously, it is not a recalc as there are no formula in the range
cells.

Can someone please assist here? Thank you for any help offered.

Frick

Example:

D1:F1 1.00 0.81 1.71

Target Cells D9:F1500 1.23 1.00 2.11 (where the
input
cell was E9 @1.00)


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

Thanks Trevor.

Bob

"Trevor Shuttleworth" wrote in message
...
Neat ... and just within two hours ... impressive !

Bob,

Great work and fast! Once again you have saved me from the snapping turtles
at my feet.

Frick

Frick,

Thanks for that. Must admit I like your problems, they are different from
the normal ones, and as I said, this one got me going.

Look forward to the next.

Bob

"Frick" wrote in message
...
Bob,

Great work and fast! Once again you have saved me from the snapping
turtles
at my feet.

Frick

Hi Bob,

The solution works great!

I discovered a slight problem that I did not anticipate in my earlier posts.
Don't flame me because it was as a consequence of how well the sheet works
that I thought it could be expanded.

In range D1:F1 on the original model I entered the 3 currency rates. With
your new code when anyone of the rates are changed the target range cells
update.

Here's what the problem is now. I have added more sheets for different
areas and built a summary sheet to bring forward certain totals. On the
summary sheet I have added a section to enter the currency rates Main
Summary F83:H83 and then linked the backup worksheets D1:F1 to Main Summary
F83:H83. This way I don't have to go to each sheet and change each
currency. Makes sense, but now the worksheets don't update when any one of
the currencies are updated on the summary sheet. As long as the the cells
in D1:F1 are values on the sheets, changes are updated. However, with D1:F1
as reference cells to the main summary sheet, now when changes are made on
the summary sheet the target range cells don't update.

So, have a cup of coffee, kick back and give it a thought.

Thanks,

Frick

Frick,

Here you go.

The code is not changed much, but there is one huge difference, and two
major assumption.

The assumptions - that every sheet in this workbook will hold similar
currency information in the same format, AND, that the main sheet is called
'Main Summary', and that is the only place that currency rates will be
changed (never on the dependent sheets)

The difference - this code goes in the This Workbook module rather than
individual sheet modules, and will thus apply to all sheets. Make sure that
you delete all of the code in the sheet modules.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
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, Sh.Range(sENTRYRANGE)) _
Is Nothing Then
For Each rArea In Sh.Range(sENTRYRANGE).Areas
If Not Intersect(.Cells, rArea) Is Nothing Then
startCol = rArea(1).Column
End If
Next rArea
rateArr = Sh.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 Sh.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
ElseIf Not Intersect(Target, Sh.Range(sRATERANGE)) _
Is Nothing Then
UpdatedRates Sh, Target
End If
End With
End Sub


Private Sub UpdatedRates(Sh As Worksheet, Target As Range)
Dim i As Long, j As Long
Dim sht As Worksheet

With Sh

For i = 9 To .Range("D1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With .Cells(i, 3 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To .Range("G1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With .Cells(i, 6 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

For i = 9 To .Range("J1500").End(xlUp).Row
Application.EnableEvents = True
For j = 1 To 3
With .Cells(i, 9 + j)
If .Font.ColorIndex = 3 Then
'if this cell is the one entered, then
' force a recalculation
.Value = .Value
End If
End With
Next j
Next i

End With

If Sh.Name = "Main Summary" Then
For Each sht In Worksheets
If sht.Name < ActiveSheet.Name Then
sht.Range(Target.Address).Value = Target.Value
End If
Next
End If

End Sub





--

HTH

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

"Frick" wrote in message
...
Hi Bob,

The solution works great!

I discovered a slight problem that I did not anticipate in my earlier
posts.
Don't flame me because it was as a consequence of how well the sheet works
that I thought it could be expanded.

In range D1:F1 on the original model I entered the 3 currency rates. With
your new code when anyone of the rates are changed the target range cells
update.

Here's what the problem is now. I have added more sheets for different
areas and built a summary sheet to bring forward certain totals. On the
summary sheet I have added a section to enter the currency rates Main
Summary F83:H83 and then linked the backup worksheets D1:F1 to Main
Summary
F83:H83. This way I don't have to go to each sheet and change each
currency. Makes sense, but now the worksheets don't update when any one
of
the currencies are updated on the summary sheet. As long as the the cells
in D1:F1 are values on the sheets, changes are updated. However, with
D1:F1
as reference cells to the main summary sheet, now when changes are made on
the summary sheet the target range cells don't update.

So, have a cup of coffee, kick back and give it a thought.

Thanks,

Frick

Bob,

I thought that was the way to go using the workbook instead of the sheets.
I tried that yesterday and could not get it to work. I did as you suggested
in the post, entered script in workbok, removed all script from sheets yet
it still is not working.

May I send you the file for you to take alook?

Frick

Okay, send it to me at

bob . phillips |@ tiscali . co . uk

remove all the spaces

--

HTH

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

"Frick" wrote in message
...
Bob,

I thought that was the way to go using the workbook instead of the sheets.
I tried that yesterday and could not get it to work. I did as you
suggested
in the post, entered script in workbok, removed all script from sheets yet
it still is not working.

May I send you the file for you to take alook?

Frick