Worksheet Code Expansion

[Phil Hageman]

Excel 2000, Sub located in the worksheet code area (not in
the workbook module).

I need to expand the existing code to cover the same
inputs and make the same calculations in two more sections
of the worksheet. As can be seen, only the row numbers
are changing. There ought to be a clean way to do this in
one sub - although I suppose I could repeat the existing
code two more times. But that would be rather messy.

In way of discussion, this code is located in
the "Customer" worksheet code object (clicking on
the "Customer" worksheet tab, view code). Once perfected,
I plan to use the exact same code in three additional
worksheets: "Financial", "Learning and Growth",
and "Internal Business Process." After the code is
perfected, should it be located in each worksheet code
object, or in the workbook code object? Looking for the
cleanest way to do this because this workbook is going to
be converted to a web document in the near future (by
others). Need some advice on this. Thanks.


EXISTING CODE PARAMETERS:
Rows: 19 through 30
P10, V10, U19:U30 (input); X19:X30 (code solutions)
P11, V11, AD19:AD30 (input); AG19:AG30 (code solutions)
P12, V12, AM19:AM30 (input); AP19:AP30 (code solutions)
P13, V13, AV19:AV30 (input); AY19:AY30 (code solutions)

EXPANSION ONE PARAMETERS:
Rows: 51 through 62
P42, V42, U51:U62 (input); X19:X30 (code solutions)
P43, V43, AD51:AD62 (input); AG51:AG62 (code solutions)
P44, V44, AM51:AM62 (input); AP51:AP62 (code solutions)
P45, V45, AV51:AV62 (input); AY51:AY62 (code solutions)

EXPANSION TWO PARAMETERS:
Rows: 83 through 94
P74, V74, U83:U94 (input); X83:X94 (code solutions)
P75, V75, AD83:AD94 (input); AG83:AG94 (code solutions)
P76, V76, AM83:AM94 (input); AP83:AP94 (code solutions)
P77, V77, AV83:AV94 (input); AY83:AY94 (code solutions)


EXISTING CODE:
Dim row As Long
row = Target.row
'Test for entries in row 19 thru 30, the month
If row >= 19 And row <= 30 Then
'Test for Target column
Select Case Target.Column
Case 21: 'For entries in column 21, "U"
Cells(row, "X").Value = _
((Target.Value - Range("V10").Value) / _
(Range("P10").Value - Range("V10").Value))
Case 30: 'For entries in column 30, "AD"
Cells(row, "AG").Value = _
((Target.Value - Range("V11").Value) / _
(Range("P11").Value - Range("V11").Value))
Case 39: 'For entries in column 39, "AM"
Cells(row, "AP").Value = _
((Target.Value - Range("V12").Value) / _
(Range("P12").Value - Range("V12").Value))
Case 48: 'For entries in column "AV"
Cells(row, "AY").Value = _
((Target.Value - Range("V13").Value) / _
(Range("P13").Value - Range("V13").Value))
End Select
End If
End Sub

 

[Tom Ogilvy]

this adaptation of JE McGimpsey's code should do it:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nRow As Long
Dim nRow1 As Long
Dim dV As Double
Dim dP As Double
Dim rng As Range
Set rng = Intersect(Range( _
"U:U,AD:AD,AM:AM,AV:AV"), Range( _
"19:30,51:62,83:94"))
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, rng) _
Is Nothing Then
nrow1 = Int((.Row - 19) / 32)
nRow = Int(.Column - 21) / 9
dV = Range("V10").Offset(nRow + 32 * nrow1, 0).Value
dP = Range("P10").Offset(nRow + 32 * nrow1, 0).Value
Application.EnableEvents = False
.Offset(0, 3).Value = (.Value - dV) / (dP - dV)
Application.EnableEvents = True
End If
End With
End Sub

 

[J.E. McGimpsey]

One way:

Just a tweak to the code I posted before:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim nRow As Long
Dim dV As Double
Dim dP As Double
Dim nStart As Long
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(.Cells, Range( _
"U19:U30,AD19:AD30,AM19:AM30,AV19:AV30," & _
"U51:U62,AD62:AD51,AM62:AM51,AV62:AV51," & _
"U83:U94,AD83:AD94,AM83:AM94,AV83:AV94")) _
Is Nothing Then
nStart = 10 - 32 * ((.Row >= 51) + (.Row >= 83))
nRow = (.Column - 21) / 9
dV = Range("V" & nStart).Offset(nRow, 0).Value
dP = Range("P" & nStart).Offset(nRow, 0).Value
Application.EnableEvents = False
.Offset(0, 3).Value = (.Value - dV) / (dP - dV)
Application.EnableEvents = True
End If
End With
End Sub

You should put this in the worksheet code module. If you want it to
occur in all the sheets, convert it to at Workbook_SheetChange()
macro, but make sure you completely qualify your ranges.

 

[Phil Hageman]

Mr. McGimpsey, Thanks much for taking your time with
this. I will copy/paste in first thing tomorrow.
Appreciate your time. Phil

 

[Phil Hageman]

Mr. McGimpsey, Thanks much for taking your time with
this. I will copy/paste in first thing tomorrow.
Appreciate your time. Phil

 

[Phil Hageman]

Sorry Tom, I got the threads mixed up. Appreciate your
time as well. You have helped me many times this year and
I am much improved for your assistance. Thanks, and have a
very Happy Holiday. Phil