Help with the scrip macro listed within

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

Frick

I have a spreadsheet with the macro script listed below, which will take
three currency exchange rates and perform a calc returning values from input
amounts. The script works fine except I have discovered that when I update
the master currency rates, the cells refernced by the macro script don't
update. I believe this is the result that when the macro executes it
returns a hard number to the cell ranges and isn't written to reset or
recalc.

Can someone please help me here. I'm not sure what I should add. I suspect
I probably will need to set a button in the area where the master exchange
rates are listed so that when anyone changes a rate they are prompted to
have everything recalced.

Thanks for any help offered.

Frick


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
 
I have a spreadsheet with the macro script listed below,
Click to expand...

Most of the people knowledgeable about macros are in the excel.programming
newsgroups. Try asking there.
 
Most of the people knowledgeable about macros are in the excel.programming
newsgroups. Try asking there.
Click to expand...

While .programming may be more appropriate for macros, most of the knowledgeabe
people who respond there also respond here.
 
I have a spreadsheet with the macro script listed below, which will take
three currency exchange rates and perform a calc returning values from input
amounts. The script works fine except I have discovered that when I update
the master currency rates, the cells refernced by the macro script don't
update. I believe this is the result that when the macro executes it
returns a hard number to the cell ranges and isn't written to reset or
recalc. ...
Private Sub Worksheet_Change(ByVal Target As Excel.Range) ...
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, Range(sENTRYRANGE)) _
Is Nothing Then ...
rateArr = Range(sRATERANGE).Value ...
End Sub
Click to expand...

The second IF statement above bails out unless some of the cells changed are in
sENTRYRANGE. If sRATERANGE doesn't overlap sENTRYRANGE, then your macro exits at
this second IF statement when you change entries in sRATERANGE.

I'd guess you wouldn't want the numbers to update each time you make a single
entry in sRATERANGE but would prefer to wait until you finish making all your
entries there. If so, then you could use a SelectionChange event handler to set
a state variable to check whether you're in the sRATERANGE range, and if so set
the state variable. Then once you leave sRATERANGE, this event handler would
re-enter sENTRYRANGE, thus effectively calling the Change event handler.


Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'time to make these module-level, ie, defined outside either handler
Const sENTRYRANGE As String = "D9:F1500,G9:I1500,J9:L1500"
Const sRATERANGE As String = "D1:F1"

Static inrng As Boolean

If inrng And Intersect(Target, Range(sRATERANGE)) Is Nothing Then
're-enter entries
Range(sENTRYRANGE).Value = Range(sENTRYRANGE).Value
inrng = False

ElseIf Not Intersect(Target, Range("foo")) Is Nothing Then
inrng = True

End If

End Sub
 
Back
Top