Cleaning up this VBA to avoid "Procedure Too Large"

K

kwp004

Board Regular
Joined
Dec 27, 2016
Messages
93
I already posted this question previously and was told there is no solution. But I think what I'm trying to do is pretty simple...

I wrote a worksheet level change and I'm getting the error message "Procedure too Large". As I understand it, since it's at the worksheet level, I can't break the <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">VBA</acronym> into multiple subs.

Basically, I'm trying to take the <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">VBA</acronym> below, and have it repeat for rows 7-35. Currently, to do that, I just copied/pasted the code below into MS Word, did find/replace 6 for 7, and pasted the result back into the <acronym title="visual basic for applications" style="border-width: 0px 0px 1px; border-top-style: initial; border-right-style: initial; border-bottom-style: dotted; border-left-style: initial; border-top-color: initial; border-right-color: initial; border-bottom-color: rgb(0, 0, 0); border-left-color: initial; border-image: initial; cursor: help;">VBA</acronym>. I then repeated that process for each row.

Anyone know a smarter way to do this? Is there a better way to write the VBA? Or is possible to create some kind of loop? Thanks!
​
 
Last edited:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Private Sub Worksheet_Change(ByVal Target As Range)

'Quantity Error

If Target.Address = "$G$6" Then
If Range("AT6") = "XXX" Then

MsgBox "Valid Inputs:" & vbCrLf & vbCrLf & "Any #>=0" & vbCrLf & vbCrLf & "All Shares Remaining" & vbCrLf & vbCrLf & "All Shares up to #" & vbCrLf & vbCrLf & "Net Shares" & vbCrLf & vbCrLf & "Sell to Cover", vbInformation, "Must Enter Valid Quantity"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent Link Error (quantity cell)

If Target.Address = "$G$6" Then
If Range("AU6") = "XXX" Then

MsgBox "For the following orders types, you must first select a contingent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to #" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Must be Contingent"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent Link Error (contingent cell)

If Target.Address = "$I$6" Then
If Range("AU6") = "XXX" Then

MsgBox "For the following orders types, you must select a contingent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to #" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Must be Contingent"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'ED < SD error

If Target.Address = "$C$6" Or Target.Address = "$D$6" Then
If Range("AV6") = "XXX" Then

MsgBox "REMINDER: Start Date < End Date", vbInformation, "Invalid Date"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'STC error

If Target.Address = "$G$6" Or Target.Address = "$J$6" Or Target.Address = "$K$6" Or Target.Address = "$L$6" Or Target.Address = "$M$6" Or Target.Address = "$N$6" Or Target.Address = "$O$6" Then
If Range("AW6") = "XXX" Then

MsgBox "For a Sell to Cover order, to record an execution:" & vbCrLf & vbCrLf & "- In the quantity column, delete sell to cover, and input the total pre-sale quantity" & vbCrLf & vbCrLf & "- In the executed column, input the execution quantity" & vbCrLf & vbCrLf & "- Any contingent orders should be adjust accordingly", vbInformation, "Invalid Execution Quantity"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent,Q or STC error

If Target.Address = "$G$6" Or Target.Address = "$I$6" Then
If Range("AX6") = "XXX" Then

MsgBox "Only the following order types can be contingent:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to X" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Type Cannot be Contingent"
Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent,ASR/ASX SD/ED Error

If Target.Address = "$C$6" Or Target.Address = "$D$6" Or Target.Address = "$G$6" Or Target.Address = "$I$6" Then
If Range("AY6") = "XXX" Then

MsgBox "REMINDER: end date of parent order < start date of a contingent order", vbInformation, "Invalid Date (contingent order)"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent,ASR or ASX link error

If Target.Address = "$G$6" Or Target.Address = "$I$6" Then
If Range("AZ6") = "XXX" Then

MsgBox "The following order types must directly follow their parent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to X", vbInformation, "Order Must Directly Proceed Parent Order"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent,NS SD/ED Error

If Target.Address = "$C$6" Or Target.Address = "$D$6" Or Target.Address = "$G$6" Or Target.Address = "$I$6" Then
If Range("BA6") = "XXX" Then

MsgBox "REMINDER: for a Net Shares order, the start date cannot come prior to the start date of the parent All Shares up to X order ", vbInformation, "Invalid Date (net shares contingent order)"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

'Contingent,NS link error

If Target.Address = "$G$6" Or Target.Address = "$I$6" Then
If Range("BB6") = "XXX" Then

MsgBox "REMINDER: a Net Shares order can only be contingent to an All Shares Up to X order", vbInformation, "Invalid Net Shares Order"

Application.EnableEvents = False
Target.Value = ""
Application.EnableEvents = True

End If
End If

End Sub
 
Upvote 0
Totally untested but maybe...

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)

    Dim irow As Long
    'Quantity Error
    For irow = 6 To 35
        If Target.Address = "$G$" & irow Then
        Debug.Print Target.Address
            If Range("AT" & irow) = "XXX" Then

                MsgBox "Valid Inputs:" & vbCrLf & vbCrLf & "Any #>=0" & vbCrLf & vbCrLf & "All Shares Remaining" & vbCrLf & vbCrLf & "All Shares up to #" & vbCrLf & vbCrLf & "Net Shares" & vbCrLf & vbCrLf & "Sell to Cover", vbInformation, "Must Enter Valid Quantity"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent Link Error (quantity cell)

        If Target.Address = "$G$" & irow Then
            If Range("AU" & irow) = "XXX" Then

                MsgBox "For the following orders types, you must first select a contingent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to #" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Must be Contingent"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent Link Error (contingent cell)

        If Target.Address = "$I$" & irow Then
            If Range("AU" & irow) = "XXX" Then

                MsgBox "For the following orders types, you must select a contingent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to #" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Must be Contingent"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'ED < SD error

        If Target.Address = "$C$" & irow Or Target.Address = "$D$" & irow Then
            If Range("AV" & irow) = "XXX" Then

                MsgBox "REMINDER: Start Date < End Date", vbInformation, "Invalid Date"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'STC error

        If Target.Address = "$G$" & irow Or Target.Address = "$J$" & irow Or Target.Address = "$K$" & _
           irow Or Target.Address = "$L$" & irow Or Target.Address = "$M$" & _
           irow Or Target.Address = "$N$" & irow Or Target.Address = "$O$" & irow Then
            If Range("AW" & irow) = "XXX" Then

                MsgBox "For a Sell to Cover order, to record an execution:" & vbCrLf & vbCrLf & "- In the quantity column, delete sell to cover, and input the total pre-sale quantity" & vbCrLf & vbCrLf & "- In the executed column, input the execution quantity" & vbCrLf & vbCrLf & "- Any contingent orders should be adjust accordingly", vbInformation, "Invalid Execution Quantity"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent,Q or STC error

        If Target.Address = "$G$" & irow Or Target.Address = "$I$" & irow Then
            If Range("AX" & irow) = "XXX" Then

                MsgBox "Only the following order types can be contingent:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to X" & vbCrLf & vbCrLf & "- Net Shares", vbInformation, "Order Type Cannot be Contingent"
                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent,ASR/ASX SD/ED Error

        If Target.Address = "$C$" & irow Or Target.Address = "$D$" & irow Or Target.Address = "$G$" & irow Or Target.Address = "$I$" & irow Then
            If Range("AY6") = "XXX" Then

                MsgBox "REMINDER: end date of parent order < start date of a contingent order", vbInformation, "Invalid Date (contingent order)"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent,ASR or ASX link error

        If Target.Address = "$G$" & irow Or Target.Address = "$I$" & irow Then
            If Range("AZ6") = "XXX" Then

                MsgBox "The following order types must directly follow their parent order:" & vbCrLf & vbCrLf & "- All Shares Remaining" & vbCrLf & vbCrLf & "- All Shares up to X", vbInformation, "Order Must Directly Proceed Parent Order"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent,NS SD/ED Error

        If Target.Address = "$C$6" Or Target.Address = "$D$6" Or Target.Address = "$G$" & irow Or Target.Address = "$I$" & irow Then
            If Range("BA6") = "XXX" Then

                MsgBox "REMINDER: for a Net Shares order, the start date cannot come prior to the start date of the parent All Shares up to X order ", vbInformation, "Invalid Date (net shares contingent order)"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If

        'Contingent,NS link error

        If Target.Address = "$G$" & irow Or Target.Address = "$I$" & irow Then
            If Range("BB6") = "XXX" Then

                MsgBox "REMINDER: a Net Shares order can only be contingent to an All Shares Up to X order", vbInformation, "Invalid Net Shares Order"

                Application.EnableEvents = False
                Target.Value = ""
                Application.EnableEvents = True

            End If
        End If
    Next
End Sub

Btw...
I just copied/pasted the code below into MS Word, did find/replace 6 for 7, and pasted the result back into the VBA
Click to expand...

Why? you can do a Find/Replace in the VB Editor, it is under the Edit tab.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA Function to Paste Table into Outlook Email Resulting in HTML language in Email
Replies
8
Views
537
smozgur
smozgur
G
  • Question Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
1K
gvsumich
G
E
  • Question Question
VBA code clean up
Replies
9
Views
482
mumps
mumps
M
  • Question Question
Please help me to correct Excel VBA code!
Replies
1
Views
308
Minh Tuan VN
M
G
  • Question Question
Draw 'X' (Diagonal lines) within selected cells and set line color
Replies
1
Views
289
sxhall
S

Forum statistics

Threads
1,223,227
Messages
6,170,848
Members
452,361
Latest member
d3ad3y3

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top