DoubleClick event- procedure too large. How to split it up?

[doctorhifi]

I created a worksheet that contains many unique formulas in each cell.
The user is allowed to overwrite and/or modify the formulas in each cell, but double-clicking on the cell will always reinsert the original formula into the cell. The original formulas are contained within the VBA Objects for the sheet. Obviously I'm using Private Sub Worksheet_BeforeDoubleClick event to achieve this.

Problem is, my procedure is now so long that I get a Procedure Too Large error.

I am wondering how to split the procedures into two parts.


Here is an example of the code within my worksheet:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("xxxx")) Is Nothing ThenRange("xxxx").Value = ("=1+2")
   Cancel = True
 End If

<hundreds more="" lines="" of="" similar="" code="">---Hundreds of more lines of code similar to the above---

 End Sub

</hundreds>

 

[DanteAmor]

Another idea is to have a backup sheet with all the formulas in the same cells, if you press doubleclick, then copy the formula from backup sheet to target cell.

The following would work for all cells that contain formulas.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Sheets("Backup").Range(Target.Address).HasFormula Then
        Target.Formula = Sheets("Backup").Range(Target.Address).Formula
    End If
End Sub

 

[doctorhifi]

Another idea is to have a backup sheet with all the formulas in the same cells, if you press doubleclick, then copy the formula from backup sheet to target cell.

The following would work for all cells that contain formulas.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    If Sheets("Backup").Range(Target.Address).HasFormula Then
        Target.Formula = Sheets("Backup").Range(Target.Address).Formula
    End If
End Sub

Thanks, DanteAmor. However, I already have all the formulas within VBA so creating the new sheet would be time consuming so I am hoping there is another way. Also, there aren't always formulas being repopulated, sometimes it is other values.

 

[Norie]

How 'unique' are the formulas?

Does every cell you want to run the code on have a completely different formula?

How are you storing the formulas in the code?

 

[DanteAmor]

It is more practical to make changes to a formula on the sheet than in VBA.
There would be no way that someone will review hundreds of lines of code to update one or several formulas.
The backup sheet can be hidden and protected. Just do a little test.


Anyway, if there is no way, then you could group cells that contangan the same formula or put parts of your code in several modules, and run each macro in these modules sending as a target parameter and receiving a result, when the result is true stop the execution.

 

[doctorhifi]

How 'unique' are the formulas?

Does every cell you want to run the code on have a completely different formula?

How are you storing the formulas in the code?

Norie,
Codes are unique. Below are a few examples. These are within the main Sheet

 '***************Remove blank lines from Description1
If Not Intersect(Target, Range("Description1")) Is Nothing Then
  Application.enableevents = False
Range("Description1mod").Value = "=ClearLineBreaks(Description1)"
Range("Description1").Value = Range("Description1mod").Value
  Application.enableevents = True
Cancel = True
End If


 '***************cab picture text
   If Not Intersect(Target, Range("CabPictureText")) Is Nothing Then
Range("CabPictureText").Value = "=IFERROR(PictureText,"""")"
   Cancel = True
 End If
 
  '***************weight alternate- creates new baseline see row 81
   If Not Intersect(Target, Range("WgtAlt")) Is Nothing Then
Range("oldwgt").Value = Range("cabweight").Value
   Cancel = True
 End If
 
 '***************date
   If Not Intersect(Target, Range("Date")) Is Nothing Then
Range("Date").Value = Date
   Cancel = True
 End If

 

[DanteAmor]

In this way you could separate all the code in several modules.

[COLOR=#0000ff]Public varStop   '<----Up to all your code[/COLOR]
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
    Call macro1(target)
    If varStop Then Exit Sub
    Call Macro2(target)
    If varStop Then Exit Sub
    Call Macro3(target)

   '...
End Sub


Sub macro1(target)
    '***************Remove blank lines from Description1
    If Not Intersect(target, Range("Description1")) Is Nothing Then
        Application.EnableEvents = False
        Range("Description1mod").Value = "=ClearLineBreaks(Description1)"
        Range("Description1").Value = Range("Description1mod").Value
        Application.EnableEvents = True
        Cancel = True
        varStop = True
    End If
    
    '***************cab picture text
    If Not Intersect(target, Range("CabPictureText")) Is Nothing Then
        Range("CabPictureText").Value = "=IFERROR(PictureText,"""")"
        Cancel = True
        varStop = True
    End If
End Sub


Sub Macro2(target)
    '***************weight alternate- creates new baseline see row 81
    If Not Intersect(target, Range("WgtAlt")) Is Nothing Then
        Range("oldwgt").Value = Range("cabweight").Value
        Cancel = True
        varStop = True
    End If
End Sub


Sub Macro3(target)
    '***************date
    If Not Intersect(target, Range("Date")) Is Nothing Then
        Range("Date").Value = Date
        Cancel = True
        varStop = True
    End If
End Sub

 

[doctorhifi]

In this way you could separate all the code in several modules.

[COLOR=#0000ff]Public varStop   '<----Up to all your code[/COLOR]
Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
    Call macro1(target)
    If varStop Then Exit Sub
    Call Macro2(target)
    If varStop Then Exit Sub
    Call Macro3(target)

   '...
End Sub


Sub macro1(target)
    '***************Remove blank lines from Description1
    If Not Intersect(target, Range("Description1")) Is Nothing Then
        Application.EnableEvents = False
        Range("Description1mod").Value = "=ClearLineBreaks(Description1)"
        Range("Description1").Value = Range("Description1mod").Value
        Application.EnableEvents = True
        Cancel = True
        varStop = True
    End If
    
    '***************cab picture text
    If Not Intersect(target, Range("CabPictureText")) Is Nothing Then
        Range("CabPictureText").Value = "=IFERROR(PictureText,"""")"
        Cancel = True
        varStop = True
    End If
End Sub


Sub Macro2(target)
    '***************weight alternate- creates new baseline see row 81
    If Not Intersect(target, Range("WgtAlt")) Is Nothing Then
        Range("oldwgt").Value = Range("cabweight").Value
        Cancel = True
        varStop = True
    End If
End Sub


Sub Macro3(target)
    '***************date
    If Not Intersect(target, Range("Date")) Is Nothing Then
        Range("Date").Value = Date
        Cancel = True
        varStop = True
    End If
End Sub

Dante,
Thanks much. That worked well.
In the context of your code, what is the purpose of varStop?

 

[DanteAmor]

Dante,
Thanks much. That worked well.
In the context of your code, what is the purpose of varStop?

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
    Call macro1(target)
    If varStop Then Exit Sub
    Call Macro2(target)
[B][COLOR=#0000ff]    If varStop Then Exit Sub[/COLOR][/B]
    Call Macro3(target)


   '...
End Sub

If the formula was found you should no longer continue with the following macros.