• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Procedure Too Large Error

VB_Noob

Member
Hi Guys,

How to break this huge procedure into multiple small ones? The codes are much much bigger. I am copying and pasting partial codes here. Basically it is a user form that display the data from a table and the program takes some user input data from the form and populate them back into the table. The form has about 600 data fields and almost half of them are user input fields.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$L$2" Then
  V = Application.Match(Target.Value, Range("A151", [A151].End(xlDown)), 0)

  If IsNumeric(V) Then
  V = 150 + V
  [F2].Value = Target.Value
  [B2].Value = Cells(V, 2).Value
  [D2].Value = Cells(V, 3).Value
  [B4].Value = Cells(V, 4).Value
  [C4].Value = Cells(V, 5).Value
  [D4].Value = Cells(V, 6).Value
  [E4].Value = Cells(V, 7).Value
  [F4].Value = Cells(V, 8).Value
  [G4].Value = Cells(V, 9).Value
  [H4].Value = Cells(V, 10).Value
  [I4].Value = Cells(V, 11).Value
  [J4].Value = Cells(V, 12).Value
  [K4].Value = Cells(V, 13).Value
  [L4].Value = Cells(V, 14).Value
  [B5].Value = Cells(V, 15).Value
  [E5].Value = Cells(V, 16).Value
  [G5].Value = Cells(V, 17).Value
Else
  If Target.Value > "" Then Beep
  [F2,B2,D2,B4,C4,D4,E4,F4,G4,H4,I4,J4,K4,L4].Value = ""
  
  End If
  
  'B2-Protocol Number
  ElseIf Target.Address = "$B$2" Then
  Dim prot As Integer
  prot = Application.Match([F2].Value, Range("A151", [A151].End(xlDown)), 0) + 150
  Range("B" & prot).Value = Range("B2").Value
  [B2].Value = Range("B" & prot).Value

'D2-Theme Number
  ElseIf Target.Address = "$D$2" Then
  Dim theme As Integer
  theme = Application.Match([F2].Value, Range("A151", [A151].End(xlDown)), 0) + 150
  Range("C" & theme).Value = Range("D2").Value
  [D2].Value = Range("C" & theme).Value
End If
 
Application.EnableEvents = True
 
End Sub
 
Hi !

Nothing to mod in your tiny code except

[B4:L4].Value = Range(Cells(V, 4), Cells(V, 14)).Value
 
@ vletm
Unfortunately reducing number of data fields are not an option.

@ Marc L,
I have only pasted partial codes. Here comes the full code. It is too big to put in one procedure. Is there way to put them into multiple sub procedures? There are If statements which makes things a little complicated.

The codes are too long to paste here. I have attached a sample form. But this one is much smaller than the one I am working on right now.

I tried to modify the code (see below) and it is not working. Basically I want to put those codes that assigning values into multiple procedures.

Code:
Sub DataB3toD3 ()
       [B3].Value = Target.Value
       [D3].Value = Cells(V, 2).Value
End Sub

Sub DataF3toH3 ()
       [F3].Value = Cells(V, 3).Value
       [H3].Value = Cells(V, 4).Value
End Sub

Sub DataB5toB14 ()
       [B5].Value = Cells(V, 5).Value
       [B7].Value = Cells(V, 6).Value
       [B9].Value = Cells(V, 7).Value
       [B11].Value = Cells(V, 8).Value
       [B12].Value = Cells(V, 9).Value
       [B13].Value = Cells(V, 10).Value
       [B14].Value = Cells(V, 11).Value
End Sub

Sub WriteData1 ()
      Dim lr As Integer
            lr = Application.Match([B3].Value, Range("A21", [A20].End(xlDown)), 0) + 20
            Range("J" & lr).Value = Range("B13").Value
            [B14].Value = Range("K" & lr).Value
End Sub

Sub WriteData2 ()
       
Dim pn As Integer
            pn = Application.Match([B3].Value, Range("A21", [A20].End(xlDown)), 0) + 20
            Range("B" & pn).Value = Range("D3").Value
            [D3].Value = Range("B" & pn).Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$N$3" Then
  V = Application.Match(Target.Value, Range("A21", [A20].End(xlDown)), 0)

  If IsNumeric(V) Then
    V = 20 + V
    Call DataB3toD3
    Call DataF3toH3
    Call DataB5toB14
  Else
    If Target.Value > "" Then Beep
      [B3,D3,F3,H3,B5,B7,B9,B11,B12.B13.B14].Value = ""
    End If

ElseIf Target.Address = "$B$13" Then
            Call WriteData1
    ElseIf Target.Address = "$D$3" Then
            Call WriteData2
End If
     
Application.EnableEvents = True
     
End Sub
 

Attachments

  • Match & Update.xlsm
    23.5 KB · Views: 3
I think the user input fields are taking up a lot of space. Is there a short cut to those codes below? I'm going to try Mark's recommendation to see how much space I can save with his version of the code.
Code:
'E86- Other Materials Per Site Unit Cost 2

  ElseIf Target.Address = "$E$86" Then

  Dim othermatpersiteunitcost2 As Integer

  Othermatpersiteunitcost2 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UA" & othermatpersiteunitcost2).Value = Range("E86").Value

  [E86].Value = Range(“UA" & othermatpersiteunitcost2).Value


'B87- Other Materials General 1

  ElseIf Target.Address = "$B$87" Then

  Dim othermatgen1 As Integer

  othermatgen1 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UE" & othermatgen1).Value = Range("B87").Value

  [B87].Value = Range(“UE" & othermatgen1).Value



'D87- Other Materials General Unit Number 1

  ElseIf Target.Address = "$D$87" Then

  Dim othermatgenunitnum1 As Integer

  othermatgenunitnum1 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UG" & othermatgenunitnum1).Value = Range("D87").Value

  [D87].Value = Range(“UG" & othermatgenunitnum1).Value


'E87- Other Materials General Unit Cost 1

  ElseIf Target.Address = "$E$87" Then

  Dim othermatgenunitcost1 As Integer

  othermatgenunitcost1 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UH" & othermatgenunitcost1).Value = Range("E87").Value

  [E87].Value = Range(“UH" & othermatgenunitcost1).Value


'B88- Other Materials General 2

  ElseIf Target.Address = "$B$88" Then

  Dim othermatgen2 As Integer

  Othermatgen2 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UL" & othermatgen2).Value = Range("B88").Value

  [B88].Value = Range(“UL" & othermatgen2).Value



'D88- Other Materials General Unit Number 2

  ElseIf Target.Address = "$D$88" Then

  Dim othermatgenunitnum2 As Integer

  Othermatgenunitnum2 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UN" & othermatgenunitnum2).Value = Range("D88").Value

  [D88].Value = Range(“UN" & othermatgenunitnum2).Value


'E88- Other Materials General Unit Cost 2

  ElseIf Target.Address = "$E$88" Then

  Dim othermatgenunitcost2 As Integer

  Othermatgenunitcost2 = Application.Match([F2].Value, Range("A156", [A156].End(xlDown)), 0) + 150

  Range("UO" & othermatgenunitcost2).Value = Range("E88").Value

  [E88].Value = Range(“UO" & othermatgenunitcost2).Value
 
The issue here is that we are trying to guess at what you actually want to achieve?

Do you want to simplify code? To what end?

Excel/VBA doesn't care if there are 600 inputs, use a line for each?

If you want to standardise the ability to transfer/clear these inputs, then it may be your data layout that is impeding the issue

Can you please post a file with a better description of what you are trying to achieve?
 
Is there a short cut to those codes below?
Find the repetitive code parts and replace them with a procedure with parameters for variable elements of original parts.
A must read in VBA help : Sub statement and its sample …
 
The issue here is that we are trying to guess at what you actually want to achieve?

Do you want to simplify code? To what end?

Excel/VBA doesn't care if there are 600 inputs, use a line for each?

If you want to standardise the ability to transfer/clear these inputs, then it may be your data layout that is impeding the issue

Can you please post a file with a better description of what you are trying to achieve?

Hi Hui,
Thanks for your reply. I've attached the sheet and the yellow highlighted fields are requiring user input. I have not completed creating the table to connect the user form yet. Basically whatever the expense that an user enters in the yellow highlighted field will get to populated into the corresponding cell of the table at the bottom. Some of the expense fields may be blank based on how an user responds to the question listed in Column B (Expense Applied? Enter 1 for Yes and 2 for No).
As you can see there are already good number of user input fields within the sheet. The actual spreadsheet that I am creating contains 10 times more user input fields than this mini sample sheet.

The following code will take user input data into the table and display the new data in the form. This code become repetitive and corresponds to each user input field created in the form. I have about 150 user input fields in my other sheet and they have overwhelmed the private sub procedure size limit (64 KB). Therefore, I would like to put them into multiple sub procedures in stead of leave them in my main private sub procedures. I have tried to create two Private Sub Worsheet_Change (VyVal Target As Range) for my sheet. But I believe I can only have one per worksheet, correct?
Code:
Target.Address = "$B$13" Then
            Dim lr As Integer
            lr = Application.Match([B3].Value, Range("A21", [A20].End(xlDown)), 0) + 20
            Range("J" & lr).Value = Range("B13").Value
            [B14].Value = Range("K" & lr).Value
 

Attachments

  • Match & Update Large Input.xlsm
    24.9 KB · Views: 3
Hi Guys,

I was able to create sub procedure for each data input field and call it from the private sub procedure. It seems to be working. Let me see how much KB it can save me in the main sub.
 
Just checking. Is there max number of sub procedures that I can write per worksheet? I will have 150 sub procedures for my worksheet and will calling each of them from the main private sub.
 

As far I know the limit per procedure is 64K once compiled
and maybe 4 000 codelines per module …​
 
Have a look at the attached.
A bit surprised you can change the Patient ID which will need a bit more coding.
 

Attachments

  • Chandoo38906Match & Update Large Input.xlsm
    24.6 KB · Views: 1
Last edited:
Back
Top