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

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
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

G
  • Question
Using Excel formula to create HTML code text referencing specific cells
Replies
0
Views
839
gvsumich
G
A
  • Question
VBA - Automatically Break the Line in HTML format.
Replies
7
Views
1K
Attrazion
A
N
  • Solved
VBA Excel opens Word - Split Screen to Windows Planes
Replies
5
Views
655
NdNoviceHlp
NdNoviceHlp
V
  • Question
Issue with scraping with VBA
Replies
1
Views
517
John_w
J
A
  • Solved
Calendar form cancel button passing data to worksheet
Replies
7
Views
408
AndyEd
A

Forum statistics

Threads
1,215,093
Messages
6,123,069
Members
449,090
Latest member
fragment

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