Procedure too large VBA excel

Question

I need some help to shorten this piece of code.

I need to use this code If (linha >= 20 And linha <= 21) for 50 line (linha) intervals

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim foto As Range
  Dim destino As Range
  Dim linha As Long
  Dim fName As String
  Dim pName As String
  Dim iName As String
  Dim iNameClean As String
  Dim iNameExcel As String
  Dim fNameExcel As String

    Set foto = Target.Cells(1)
    Set destino = Me.Range("AU:BC,BN:BV,CG:CO,CZ:DH,DS:EA,EL:ET,FE:FM,FX:GF,GQ:GY,HJ:HR,IC:IK,IV:JD,JO:JW,KH:KP,NF:NN,NY:OG,OR:OZ,PK:PS")
    If Not Application.Intersect(foto, destino) Is Nothing Then
        linha = foto.Row


    If (linha >= 20 And linha <= 21) Then
        With ActiveSheet
    fName = Application.GetOpenFilename("Picture files (*.jpg;*.gif;*.bmp;*.tif), *.jpgs;*.gif;*.bmp;*.tif", , _
"Select picture to insert")
            iName = Dir("" & fName & "")
            If fName = "False" Then Exit Sub
            iNameClean = Left(iName, Len(iName) - 4)
            iNameExcel = "+Info"
            fNameExcel = "F:\path\EXCEL\" & foto.Offset(1, 3).Value & ".xlsx"
            With ActiveSheet
            .Unprotect Password:="1234"
                ActiveSheet.Pictures.Insert(fName).Select
                foto.Offset(0, 2).Formula = "=HYPERLINK(""" & fName & """,""" & iNameClean & """)"
                foto.Offset(0, 2).Font.ColorIndex = 1 ' preto
                foto.Offset(0, 2).Font.Size = 9
                foto.Offset(0, 2).Font.Underline = False
                foto.Offset(0, 3).Formula = "=HYPERLINK(""" & fNameExcel & """,""" & iNameExcel & """)"
                foto.Offset(0, 3).Font.ColorIndex = 1 ' preto
                foto.Offset(0, 3).Font.Size = 9
                foto.Offset(0, 3).Font.Underline = False
                With Selection.ShapeRange
                    .LockAspectRatio = msoFalse
                    .Height = ActiveCell.MergeArea.Height
                    .Width = ActiveCell.MergeArea.Width
                    .Top = ActiveCell.Top
                    .Left = ActiveCell.Left
                End With
             .Protect Password:="1234"
            End With
        End With
    End If

End Sub

If you can [edit] the title to succinctly explain *what the code does*, and expand a bit about the surrounding context in the question body, this would be a perfect question for [codereview.se]. As it stands, it's a bit *too broad* of a question to be on-topic for Stack Overflow. — Mathieu Guindon, Apr 26 '16 at 16:43
Why do you need to shorten your code? If you get the error "procedure too large" then just break it down into several procedures. And if the module size is exceeded then distribute your code across several modules. — Ralph, Apr 26 '16 at 16:44
@Ralph If you get the "procedure too large" error, you have much bigger problems, and need to read up a bit on [SRP](https://en.wikipedia.org/wiki/Single_responsibility_principle) ;-) — Mathieu Guindon, Apr 26 '16 at 16:47
What do you mean "for 50 line (linha) intervals"? I'm guessing this could be accomplished with a loop... — David Zemens, Apr 26 '16 at 16:50
I'm getting the error because there is a bunch of lines of code. Just don't put them all here. I think you got it by reading what I wrote. — Anibal, Apr 26 '16 at 16:51
No, from the comments (mine, and others), the problem is that we **don't** understand what you're asking. — David Zemens, Apr 26 '16 at 16:51
@Mat'sMug I don't see how that as applicable to VBA. For all I can tell (and understand from the OP) the above question has already been answered here: http://stackoverflow.com/questions/3751263/procedure-too-large — Ralph, Apr 26 '16 at 16:52
Ralph, You mean by call function, right? I've tried but without success. Something like End With End With Call sublines End If Sub sublines() If (linha >= 20 And linha <= 21) Then (...) — Anibal, Apr 26 '16 at 16:53
@Ralph it's very likely applicable here. Assuming the contents of the `If` block can be compartmentalized to another sub/function(s) which accept some arguments. — David Zemens, Apr 26 '16 at 16:54
Oh wait, is that `If linha >= x And linha <= y Then` chunk copy+pasted so many times the procedure length actually goes beyond the limit? If so, then yeah @Ralph's link has your answer, and your question is a bit unclear. That said, if you're looking for help breaking it down into more manageable pieces and making it more efficient altogether, [codereview.se] remains the place to go. — Mathieu Guindon, Apr 26 '16 at 16:59
Yes Mat'sMug it's exactly that. I did not know that site. Thanks! I will try the Ralph's link first. — Anibal, Apr 26 '16 at 17:04
I can hardly imagine this small piece of code being too large. I have written far larger procedures. — Paul Ogilvie, Apr 26 '16 at 17:23

score 1 · Accepted Answer · answered Apr 26 '16 at 17:23

First, don't put entire functional procedures in an event handler. Put only the minimal code required to route the event to the appropriate procedure. This keeps your event handlers concise, and easier to maintain. The bulk of the work will be happening in additional procedures.

I'll define a new procedure DoStuff which will process the linhas, and the parameters which we send to DoStuff can be controlled within a Case switch.

This way, the DoStuff procedure body doesn't need to be copied 50 times or more, you can simply add to the Case statements in the Worksheet_Change event handler, and making changes (if needed) on the optional parameters.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim foto as Range
  Dim destino as Range
  Dim linha As Long

    Set foto = Target.Cells(1)
    Set destino = Me.Range("AU:BC,BN:BV,CG:CO,CZ:DH,DS:EA,EL:ET,FE:FM,FX:GF,GQ:GY,HJ:HR,IC:IK,IV:JD,JO:JW,KH:KP,NF:NN,NY:OG,OR:OZ,PK:PS")
    If Not Application.Intersect(foto, destino) Is Nothing Then
        linha = foto.Row
    End If

    Select Case linha
        Case 20, 21
            Call DoStuff(foto, 1, 9, "1234")

        '### Simply add additional "Case" statements for each linha pair
        '    NOTE: You can send different parameters to the DoStuff procedure!
        Case 22, 23
            Call DoStuff(foto, 1, 9, "ABCD", "G:\another path\Excel\", ".xlsb")


        'Etc...

    End Select

End Sub

Here is the DoStuff procedure. This procedure takes the foto range (or, any range object, technically), and optional parameters (with default values) for password, filepath, fileExt (which are used in the With block).

Sub DoStuff(foto as Range, _
            Optional fontColor as Long=1, 
            Optional fontSize as Long=9, _
            Optional password as String="1234", _
            Optional filePath as String="F:\path\EXCEL\", _
            Optional fileExt as String=".xlsx")

  Dim fname as String
  Dim pName As String
  Dim iName As String
  Dim iNameClean As String
  Dim iNameExcel As String
  Dim fNameExcel As String

    If Right(filePath,1) <> "\" Then filePath = filePath & "\"

    fName = Application.GetOpenFilename("Picture files (*.jpg;*.gif;*.bmp;*.tif), *.jpgs;*.gif;*.bmp;*.tif", , _
    "Select picture to insert")
    iName = Dir("" & fName & "")
    If fName = "False" Then Exit Sub
    iNameClean = Left(iName, Len(iName) - 4)
    iNameExcel = "+Info"
    fNameExcel = filePath & foto.Offset(1, 3).Value & fileExt

    With foto.Parent 'Worksheet
        .Unprotect Password:=password
        .Pictures.Insert(fName).Select
        With foto.Offset(0,2)
            .Formula = "=HYPERLINK(""" & fName & """,""" & iNameClean & """)"
            .Font.ColorIndex = fontColor ' preto
            .Font.Size = fontSize
            .Font.Underline = False
        End With
        With foto.Offset(0, 3)
            .Formula = "=HYPERLINK(""" & fNameExcel & """,""" & iNameExcel & """)"
            .Font.ColorIndex = fontColor ' preto
            .Font.Size = fontSize
            .Font.Underline = False
        End With
        With Selection.ShapeRange
            .LockAspectRatio = msoFalse
            .Height = foto.MergeArea.Height
            .Width = foto.MergeArea.Width
            .Top = foto.Top
            .Left = foto.Left
        End With
     .Protect Password:=password
    End With

End Sub

Good advice. Seeing 200 lines of code in a single event handler is a pet peeve of mine. An event should always call a verb (method) with only arguments that might change as the program runs. — John Alexiou, Apr 26 '16 at 17:49

Procedure too large VBA excel

1 Answers1