How to create a shared procedure

[jycpooh]

My workbook has 3 very hidden master worksheets, named PANEL, DIST and
LOADS. This workbook is designed for electrical wiring calculation.
The user click on a button to make x copies of PANEL, and name it
Panel1, Panel2, Panel3 ..etc.
In the master worksheet PANEL I have worksheet change code. Here are a
small portion of the codes.


Sub Worksheet_Change(ByVal Target As Range)

Dim whereto As String
whereto = Target.Value

Dim CurrSht As String
CurrSht = ActiveSheet.Name

If Target.Cells.Count > 1 Then Exit Sub


If Not Intersect(Target, Range("LeftSide")) Is Nothing Then
If Application.WorksheetFunction.IsText(Target.Value) Then
If Target.Offset(0, 1) = "X" Then
If SheetExists(whereto) = "True" Then
Worksheets(whereto).Range("Transformer") = CurrSht
Worksheets(whereto).Range("sourceXfmrKVA") = Target.Offset(-1,
0)
Worksheets(CurrSht).Select 'return to original sheet

If Worksheets(whereto).Range("zID") = "PANEL" Then
If Worksheets(whereto).Range("ConfigNum") = 7 Or
Worksheets(whereto).Range("ConfigNum") = 8 Then
If Target.Offset(-1, 32) = 3 Or Target.Offset(-2, 32) = 3
Then GoTo Sloppy 'if 3-pole then obvious can't feed 1-phase panel
If Target.Offset(-1, 32) = 2 Then 'if template is 2-phase
transformer
Worksheets(whereto).Range("HA1stPhase") = Target.Offset(-1,
34) 'Enter 1st Phase (say "B") from panel "HA" in "LA" cell
Range("HA1stPhase")
Worksheets(whereto).Range("HA1stPhase").Offset(1, 0) =
Target.Offset(0, 34) 'Enter 2nd Phase (say "C") from panel "HA" in
"LA" cell Range("HA1stPhase").offset by 1
End If
End If
End If

If Worksheets(whereto).Range("zID") = "DIST" Then
If Target.Offset(-2, 32) = 3 Then
Worksheets(whereto).Range("NumPhase") = "3Ph"
Worksheets(whereto).Range("sourcePhA") = "A":
Worksheets(whereto).Range("sourcePhB") = "B":
Worksheets(whereto).Range("sourcePhC") = "C"
End If
If Target.Offset(-1, 32) = 2 Then
Worksheets(whereto).Range("sourceEqptName") = CurrSht
Worksheets(whereto).Range("NumPhase") = "1Ph"
Worksheets(whereto).Range("sourcePhA").ClearContents:
Worksheets(whereto).Range("sourcePhB").ClearContents:
Worksheets(whereto).Range("sourcePhC").ClearContents
Select Case Target.Offset(-1, 34)
Case "A": Worksheets(whereto).Range("sourcePhA") = "A":
Worksheets(whereto).Range("sourcePhB") = "B"
Case "B": Worksheets(whereto).Range("sourcePhB") = "B":
Worksheets(whereto).Range("sourcePhC") = "C"
Case "C": Worksheets(whereto).Range("sourcePhC") = "C":
Worksheets(whereto).Range("sourcePhA") = "A"
End Select
End If
End If

Else
MsgBox ("Specified panel does not exist !! Your input will be
cleared and replaced with an arbitrary load of 2 KVA.")
Target.Value = 2
End If
End If
End If
End If

‘************ more codes similar to above *******
‘************* there are about 5 pages of codes similar to above
continuing here ****
‘ **********************
‘**********************
End sub


Since every copy of PANEL also carry the 5 sheets of Worksheet-Change
code, this makes the workbook much bigger. On some of our projects, we
easily have 20 or more copies of PANEL, therefore there would be more
than 20 x 5 = 100 pages of the same code in those copies of PANEL
worksheets. Similar problem with the master DIST worksheet.
Here is my attempt to make it smaller by creating a shared procedure
called by each copy of PANEL.



Sub Worksheet_Change(ByVal Target As Range)
' Call a shared procedure.PanelChanges


Dim whereto As String
whereto = Target.Value

Dim CurrSht As String
CurrSht = ActiveSheet.Name


If Target.Cells.Count > 1 Then Exit Sub

Dim rCell as range
Set rCell=Target

PanelChanges Target ‘call a shared procedure

End Sub






Sub PanelChanges(rCell as Range)
‘shared procedure for all copies of PANEL


If Not Intersect(rCell, Range("LeftSide")) Is Nothing Then
If Application.WorksheetFunction.IsText(rCell.Value) Then
If rCell.Offset(0, 1) = "X" Then
If SheetExists(whereto) = "True" Then
Worksheets(whereto).Range("Transformer") = CurrSht
Worksheets(whereto).Range("sourceXfmrKVA") = rCell.Offset(-1,
0)
Worksheets(CurrSht).Select 'return to original sheet

If Worksheets(whereto).Range("zID") = "PANEL" Then
If Worksheets(whereto).Range("ConfigNum") = 7 Or
Worksheets(whereto).Range("ConfigNum") = 8 Then
If rCell.Offset(-1, 32) = 3 Or rCell.Offset(-2, 32) = 3 Then
GoTo Sloppy 'if 3-pole then obvious can't feed 1-phase panel
If rCell.Offset(-1, 32) = 2 Then 'if template is 2-phase
transformer
Worksheets(whereto).Range("HA1stPhase") = rCell.Offset(-1,
34) 'Enter 1st Phase (say "B") from panel "HA" in "LA" cell
Range("HA1stPhase")
Worksheets(whereto).Range("HA1stPhase").Offset(1, 0) =
rCell.Offset(0, 34) 'Enter 2nd Phase (say "C") from panel "HA" in "LA"
cell Range("HA1stPhase").offset by 1
End If
End If
End If

If Worksheets(whereto).Range("zID") = "DIST" Then
If rCell.Offset(-2, 32) = 3 Then
Worksheets(whereto).Range("NumPhase") = "3Ph"
Worksheets(whereto).Range("sourcePhA") = "A":
Worksheets(whereto).Range("sourcePhB") = "B":
Worksheets(whereto).Range("sourcePhC") = "C"
End If
If rCell.Offset(-1, 32) = 2 Then
Worksheets(whereto).Range("sourceEqptName") = CurrSht
Worksheets(whereto).Range("NumPhase") = "1Ph"
Worksheets(whereto).Range("sourcePhA").ClearContents:
Worksheets(whereto).Range("sourcePhB").ClearContents:
Worksheets(whereto).Range("sourcePhC").ClearContents
Select Case rCell.Offset(-1, 34)
Case "A": Worksheets(whereto).Range("sourcePhA") = "A":
Worksheets(whereto).Range("sourcePhB") = "B"
Case "B": Worksheets(whereto).Range("sourcePhB") = "B":
Worksheets(whereto).Range("sourcePhC") = "C"
Case "C": Worksheets(whereto).Range("sourcePhC") = "C":
Worksheets(whereto).Range("sourcePhA") = "A"
End Select
End If
End If

Else
MsgBox ("Specified panel does not exist !! Your input will be
cleared and replaced with an arbitrary load of 2 KVA.")
Target.Value = 2
End If
End If
End If
End If


‘… more codes
‘** more codes
‘** more codes ( about 5 pages of codes)

End Sub



This attempt failed. I would appreciate it very much any help and tips
on how to make the shared procedure work.


Jim Chee
Houston, TX

 

[GS]

What you need to do here is use a Class module to monitor Workbook
events, and use the 'SheetChange' event in there so it applies to all
worksheets in the project workbook. You could even make it apply to
sheets in any other workbook if you put the code in a separate file
(like XLA, for example). This would require checking to make sure the
sheet belongs to your project workbook so it doesn't run the code on
just any worksheet. You could set a class property (or variable)
something like "SheetIsValid" in the 'SheetActivate' event that tells
your 'SheetChange' event if the active sheet is a valid project sheet.
I use a function that returns a boolean value for this, and just pass a
ref to the worksheet. Note that this class 'SheetChange' event also
passes a ref to the sheet (ByVal Sh As Object, ByVal Target As Range).
So you could, for example, implement something like this in the
'SheetChange' event:

If bValidSheet(Sh) Then
'call your sheet change procedure, passing 'Sh' as ref to the sheet
End If

Something of this nature changes the status of your project from a
'glorified workbook with macros' to an Excel addin 'application'. This
means your project workbook won't have to contain any code. It also
gives you a lot more flexibility because revisions to the code don't
effect the project's working file, and vice versa. Also, everyone can
run the addin from a network server, making maintenance an easy chore
over having to redistribute revisons to everyone in your organization.

HTH

 

[jycpooh]

What you need to do here is use a Class module to monitor Workbook
events, and use the 'SheetChange' event in there so it applies to all
worksheets in the project workbook. You could even make it apply to
sheets in any other workbook if you put the code in a separate file
(like XLA, for example). This would require checking to make sure the
sheet belongs to your project workbook so it doesn't run the code on
just any worksheet. You could set a class property (or variable)
something like "SheetIsValid" in the 'SheetActivate' event that tells
your 'SheetChange' event if the active sheet is a valid project sheet.
I use a function that returns a boolean value for this, and just pass a
ref to the worksheet. Note that this class 'SheetChange' event also
passes a ref to the sheet (ByVal Sh As Object, ByVal Target As Range).
So you could, for example, implement something like this in the
'SheetChange' event:

  If bValidSheet(Sh) Then
    'call your sheet change procedure, passing 'Sh' as ref to the sheet
  End If

Something of this nature changes the status of your project from a
'glorified workbook with macros' to an Excel addin 'application'. This
means your project workbook won't have to contain any code. It also
gives you a lot more flexibility because revisions to the code don't
effect the project's working file, and vice versa. Also, everyone can
run the addin from a network server, making maintenance an easy chore
over having to redistribute revisons to everyone in your organization.

HTH

--
Garry

Free usenet access athttp://www.eternal-september.org
ClassicVB Users Regroup! comp.lang.basic.visual.misc

Garry,
Thanks for your suggestion. I am not up to speed on Class Module, and
it would probably take me a long time to study and master it.
meanwhile are there someways to make it work without the use of Class
Module.

Thanks
Jim Chee
Houston, TX

 

[GS]

jycpooh was thinking very hard :

Garry,
Thanks for your suggestion. I am not up to speed on Class Module, and
it would probably take me a long time to study and master it.
meanwhile are there someways to make it work without the use of Class
Module.

Thanks
Jim Chee
Houston, TX

Not that I know of. If you plan to continue working on projects of this
level and are interested in acquiring some good books on VBA and Excel
application development, check this website out.

http://www.appspro.com/Books/Books.htm