Breaking up a procedure into modules

R

rob nobel

I've pasted in the entire procedure from a worksheet in the hope that I can
find a way to break it up into smaller Modules that I can call back so that
it becomes clearer to follow.
The problem I have is mainly to do with the "Target" bit. When I delete a
portion of this code and place it in a module, it says a variable is not
set. I've tried to put any variables immediately before the 1st procedure
and, I've also tried naming them as Public without success. AND tried to
show them as variables above the module. (For some reason, when placing part
of the code in a module, it seems as if Excel thinks the "Target" part is a
variable??).
What I'd like to do is with some of the larger sections only, (that are
preceded by an 'explanation note), to cut that section of code, paste it
into a new module, then Call it back into the procedure.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim otherCell As Range

On Error GoTo errHandler:

If Intersect(Target, Me.Range("N26:N1525")) Is Nothing Then GoTo
NextTest1 Else GoTo BalCol
NextTest1:
'to remove code selected if A'C name is changed
If Not Intersect(Target, Me.Range("G26:G1525")) Is Nothing Then
If ActiveCell.Offset(0, 6) = "" Then Exit Sub
ActiveCell.Offset(0, 6).ClearContents
ActiveCell.Offset(0, 6).Select
End If

'Exit if more than 1 cell is selected in target range
If Target.Cells.Count > 1 Then Exit Sub
'Exit if active cell is not in target range
If Intersect(Target, Me.Range("I:J")) Is Nothing Then Exit Sub
'Exit if there is not a value in both debit and credit col
If Application.CountA(Me.Cells(Target.Row, "I").Resize(1, 2)) < 2 Then
Exit Sub
End If

'Set variable with amount in the adjacent cell
Set otherCell = Me.Cells(Target.Row, 19 - Target.Column)
Application.GoTo Target
If Target.Column = 9 Then
If MsgBox("You cannot enter an amount for both credit and debit for
this item." _
& vbLf & "Select OK to keep the new amount and delete the CREDIT
amount of $" & otherCell.Value _
& vbLf & "Select Cancel to UNDO.", vbOKCancel) = vbCancel Then
ActiveCell.ClearContents
Exit Sub
End If
Application.GoTo Target
otherCell.ClearContents
Target.Offset(0, 4).ClearContents
Target.Offset(0, 4).Select
Exit Sub
Else
If MsgBox("You cannot enter an amount for both credit and debit for this
item." _
& vbLf & "Select OK to keep the new amount and delete the DEBIT
amount of $" & otherCell.Value _
& vbLf & "Select Cancel to UNDO.", vbOKCancel) = vbCancel Then
ActiveCell.ClearContents
Exit Sub
End If
Target.Offset(0, 3).ClearContents
End If
Application.GoTo Target
otherCell.ClearContents
Target.Offset(0, 3).Select
Exit Sub

BalCol:
'To lock some cells in balanced row
'If vBalMode = True Then Exit Sub 'If not in bal mode
'else

With Target
If UCase(.Value) = "X" Then
.Offset(0, -7).Resize(1, 2).Value = _
.Offset(0, -7).Resize(1, 2).Value 'Delete formula and
Cheque No
.Offset(0, -7).Resize(1, 7).Locked = True
.Offset(0, 2).Resize(1, 3).Locked = True
.Offset(0, -7).Resize(1, 7).Font.ColorIndex = 5
.Offset(0, -7).Validation.InCellDropdown = False
ElseIf .Value = "" Then
'To undo if X is deleted
.Offset(0, -7).Resize(1, 7).Locked = False
.Offset(0, 2).Resize(1, 3).Locked = False
.Offset(0, -7).Resize(1, 7).Font.ColorIndex = 0
.Offset(0, -7).Validation.InCellDropdown = True
End If
End With

errHandler:
Application.EnableEvents = True
End Sub
'Generally Code to bring up userforms for Code col
Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim PvtTable As PivotTable
On Error GoTo errHandler:
If vBalMode = True Then Exit Sub ' to prevent these procedures when
balancing

'Input Tax Credit column procedure
If Not Intersect(Target, Me.Range("O26:O1525")) Is Nothing Then
If ActiveCell.Offset(0, -10) = "" Then
If MsgBox("As no amount has been entered in the GST SECTION,
column 3," _
& vbLf & " this item does not apply for an Input Tax
Credit." _
& vbLf _
& vbLf & "Choose Yes if this item will not have an Input
Tax Credit." _
& vbLf _
& vbLf & "Choose No if you still need to show the Input
Tax credit (Gst) amount in the Gst Section.", vbYesNo, vbInformation) =
vbYes Then
ActiveCell.Value = "NA"
Exit Sub
End If
ActiveCell.ClearContents
ActiveCell.Offset(0, -10).Select
Exit Sub
End If
ufInputCreditMonth.Show
End If

'If active cell is not in this range then do nothing
If Intersect(Target, Me.Range("M26:M1525")) Is Nothing Then Exit Sub
'If more than 1 cell is active then do nothing
If Target.Cells.Count > 1 Then Exit Sub
'No account
If Me.Cells(Target.Row, "G") = "" Then
MsgBox "You need to select an account first. Do NOT skip any rows!."
ActiveCell.Offset(0, -6).Select
Exit Sub
End If
'no Debit or Credit
If Me.Cells(Target.Row, "I") = "" And Me.Cells(Target.Row, "J") = ""
Then
MsgBox "You need to enter an amount for Debit or Credit first."
ActiveCell.Offset(0, -4).Select
Exit Sub
End If
'No Date
If Me.Cells(Target.Row, "L") = "" Then
MsgBox "You need to enter a date first."
ActiveCell.Offset(0, -1).Select
Exit Sub
End If
'otherwise select the correct pivot table fields
Select Case UCase(Me.Cells(Target.Row, "G").Value)
Case Is = UCase(Me.Range("G16").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable1")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable1")
End If
Case Is = UCase(Me.Range("G17").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable2")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable2")
End If
Case Is = UCase(Me.Range("G18").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable3")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable3")
End If
Case Is = UCase(Me.Range("G19").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable4")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable4")
End If
Case Is = UCase(Me.Range("G20").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable5")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable5")
End If
Case Is = UCase(Me.Range("G21").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable6")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable6")
End If
Case Is = UCase(Me.Range("G22").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable7")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable7")
End If
Case Is = UCase(Me.Range("G23").Value)
If Cells(Target.Row, "I") > 0 Then
Set PvtTable = Sheet15.PivotTables("PivotTable8")
ElseIf Cells(Target.Row, "J") > 0 Then
Set PvtTable = Sheet11.PivotTables("PivotTable8")
End If
End Select
'not sure if this is required. If it is, then do a warning box.
If PvtTable Is Nothing Then
Exit Sub
'place warnings here ...
End If
ufSelectCode.ListBox1.List _
= PvtTable.RowFields(1).DataRange.Resize(, 2).Value
ufSelectCode.Show
Exit Sub
errHandler:
Application.EnableEvents = True
End Sub
 
J

JE McGimpsey

Target is just a range variable passed by the system to the event macro,
so you can in turn pass that on to other code.

You can create a number of modules for the individual subs. For
instance, in a regular code module put all the code from the
Worksheet_Change macro, starting at Dim otherCellAs Range, down to
errHandler:Application.EnableEvents = True:

Public Sub WSChange(ByVal Target As Excel.Range)
Dim otherCellAs Range
...
errHandler:
Application.EnableEvents = True
End Sub

Convert any "Me" references to the worksheet and make sure ranges are
fully qualified, e.g., replace

Me.Range("G26:G1625")

with

Target.Parent.Range("G26:G1625")


Then in the Worksheet code module, use

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
WSChange Target
End Sub

Note that there's nothing special about the name "Target". You can
change it in either or both subroutines to whatever you'd like, as long
as you're consistent within each procedure.
 
R

rob nobel

Thanks JE, that certainly makes it clearer and will certainly help me in my
endeavour.

Rob
 
R

rob nobel

Thanks JE.
That will help nicely.
Rob

JE McGimpsey said:
Target is just a range variable passed by the system to the event macro,
so you can in turn pass that on to other code.

You can create a number of modules for the individual subs. For
instance, in a regular code module put all the code from the
Worksheet_Change macro, starting at Dim otherCellAs Range, down to
errHandler:Application.EnableEvents = True:

Public Sub WSChange(ByVal Target As Excel.Range)
Dim otherCellAs Range
...
errHandler:
Application.EnableEvents = True
End Sub

Convert any "Me" references to the worksheet and make sure ranges are
fully qualified, e.g., replace

Me.Range("G26:G1625")

with

Target.Parent.Range("G26:G1625")


Then in the Worksheet code module, use

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
WSChange Target
End Sub

Note that there's nothing special about the name "Target". You can
change it in either or both subroutines to whatever you'd like, as long
as you're consistent within each procedure.
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Select Case and different criteria 4
Format using VBA not activating when needed 4
Excel Worksheet_change with 2 functions to insert date and hyperlink window 0
Two variables for Target.Value 5
DATE SCRIPT / add function col A, 2
help with EXCEL SCRIPT 16
Excel How to run multiple Private Sub Worksheet_Change(ByVal Target As Range) 0
macro: combine / modify date / hilite 1

Top