Divide code to avoid "Procedure too large error"

[Cris VS]

Hello all,

I have a giant procedure that exports a set of queries from access to excel and formats the excel sheet. A lot of code parts are repeated several times throughout the code and I would like to know if someone could explain how to take these bits out and call them somehow like if they were a function.

My code looks more or less like this:

Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Dim db As DAO.Database
Dim qdf1, qdf2, qdf3, qdf4, qdf5 As DAO.QueryDef
Dim rs1, rs2, rs3, rs4, rs5 As DAO.Recordset
Dim nrow, rowcount, lastrow As Long 'And other strings like x,y,adr

On Error GoTo SubError
DoCmd.Hourglass True
    
    Set db = CurrentDb()
    
    'Event name:
    Set qdf1 = db.QueryDefs("QueryEvent")
    qdf1!ParEvent = [Forms]![EventForm]![Event]
    Set rs1 = qdf1.OpenRecordset
    If rs1.RecordCount = 0 Then
        MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
        GoTo SubExit
    End If
    
    Set xlApp = Excel.Application
    
    xlApp.Visible = False
    xlApp.DisplayAlerts = False
    
        Set xlWorkbook = xlApp.Workbooks.Add
        Set xlSheet = xlWorkbook.Worksheets(1)
                
        With xlSheet
            
            'GENERAL FORMATTING
            .Name = "Event Summary"
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = 10
            .Cells.VerticalAlignment = xlCenter
            .Columns.WrapText = False
            .Columns.ColumnWidth = 10
            .Cells.Interior.Color = RGB(255, 255, 255)
                                  
            'Print setup
            .PageSetup.Orientation = xlLandscape
            .PageSetup.FitToPagesWide = 1
            .PageSetup.PaperSize = xlPaperA4
            .PageSetup.Zoom = 40
            
            'With loop that gets repeated
            With .Columns("K")
                .ColumnWidth = 17
                .HorizontalAlignment = xlCenter
                .FormatConditions.Add(xlCellValue, xlEqual, "O").Interior.Color = RGB(38, 250, 58)
                .FormatConditions.Add(xlCellValue, xlEqual, "OG").Interior.Color = RGB(0, 176, 80)
                .FormatConditions.Add(xlCellValue, xlEqual, "F").Interior.Color = RGB(192, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(246, 134, 206)
                .FormatConditions.Add(xlCellValue, xlEqual, "N").Interior.Color = RGB(191, 191, 191)
                .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(255, 255, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "NT").Interior.Color = RGB(255, 192, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "NO").Interior.Color = RGB(255, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "W").Interior.Color = RGB(0, 176, 240)
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Interior.Color = RGB(0, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Bold = True
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Color = RGB(255, 0, 0)
            End With
            
            'For loop that gets repeated
            If .Range("I" & rowcount).Value = "" Then
                .Range("C" & rowcount & ":O" & rowcount).Value = "No items"
                .Range("C" & rowcount & ":O" & rowcount).Merge
                .Range("C" & rowcount & ":O" & rowcount).HorizontalAlignment = xlLeft

            Else
                For nrow = rowcount To lastrow
                    ye = .Cells(nrow, 2) & ""
                    ype = .Cells(nrow, 3) & ""
                    ypu= .Cells(nrow, 4) & ""
                    ys = .Cells(nrow, 5) & ""
                    yi = .Cells(nrow, 6) & ""
                    yt = .Cells(nrow, 13) & ""
                    
                    If Len(ye) Then
                        If ye = xe Then
                            adre = .Cells(nrow - 1, 2).Address & ":" & .Cells(nrow, 2).Address
                            .Range(adre).Merge
                        End If
                    End If
                    If ype = xpe And ye = xe Then
                        adrpe = .Cells(nrow - 1, 3).Address & ":" & .Cells(nrow, 3).Address
                        .Range(adrpe).Merge
                    End If
                    If ype = xpe And ye = xe And ypu = xpu Then
                        adrpu = .Cells(nrow - 1, 4).Address & ":" & .Cells(nrow, 4).Address
                        .Range(adrpu).Merge
                    End If
                    If Len(ys) Then
                        If ys = xs And ype = xpe And ye = xe And ypu = xpu Then
                            adrs = .Cells(nrow - 1, 5).Address & ":" & .Cells(nrow, 5).Address
                            .Range(adrs).Merge
                        End If
                    End If
                    If Len(yi) And ype = xpe And ye = xe And ypu = xpu And ys = xs Then
                        If yi = xi Then
                            'Merge index
                            adri = .Cells(nrow - 1, 6).Address & ":" & .Cells(nrow, 6).Address
                            .Range(adri).Merge
                            'Merge ti
                            adrti = .Cells(nrow - 1, 7).Address & ":" & .Cells(nrow, 7).Address
                            .Range(adrti).Merge
                            'Merge tr
                            adrtr = .Cells(nrow - 1, 8).Address & ":" & .Cells(nrow, 8).Address
                            .Range(adrtr).Merge
                            'Merge fi
                            adrfi = .Cells(nrow - 1, 9).Address & ":" & .Cells(nrow, 9).Address
                            .Range(adrfi).Merge
                            'Merge av
                            adrav = .Cells(nrow - 1, 10).Address & ":" & .Cells(nrow, 10).Address
                            .Range(adrav).Merge
                            'Merge vs
                            adrvs = .Cells(nrow - 1, 11).Address & ":" & .Cells(nrow, 11).Address
                            .Range(adrvs).Merge
                            'Merge n
                            adrn = .Cells(nrow - 1, 12).Address & ":" & .Cells(nrow, 12).Address
                            .Range(adrn).Merge
                        End If
                    End If
                    If Len(yt) And ype = xpe And ye = xe And ypu = xpu And ys = xs And yi = xi Then
                        If yt = xt Then
                            'Merge t
                            adrt = .Cells(nrow - 1, 13).Address & ":" & .Cells(nrow, 13).Address
                            .Range(adrt).Merge
                            'Merge e
                            adre = .Cells(nrow - 1, 14).Address & ":" & .Cells(nrow, 14).Address
                            .Range(adre).Merge
                            'Merge t
                            adrt = .Cells(nrow - 1, 15).Address & ":" & .Cells(nrow, 15).Address
                            .Range(adrt).Merge
                        End If
                    End If
                    
                    xt = yt
                    xi = yi
                    xs = ys
                    xpu = ypu
                    xpe = ype
                    xe = ye
                Next nrow
            End If
            
            'Other code'
            
            .Range("B2").Select
       End With

xlApp.ActiveWindow.Zoom = 75
xlApp.DisplayAlerts = True
xlApp.Visible = True

MsgBox "File exported successfully", vbInformation + vbOKOnly, "Export success"
          
SubExit:
    DoCmd.Hourglass False
    On Error Resume Next
    
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing

    Set db = Nothing
    
    Set rs1 = Nothing
    Set rs2 = Nothing
    Set rs3 = Nothing
    Set rs4 = Nothing
    Set rs5 = Nothing
    
    Set qdf1 = Nothing
    Set qdf2 = Nothing
    Set qdf3 = Nothing
    Set qdf4 = Nothing
    Set qdf5 = Nothing
    
    rs1.Close
    rs2.Close
    rs3.Close
    rs4.Close
    rs5.Close
    
    qdf1.Close
    qdf2.Close
    qdf3.Close
    qdf4.Close
    qdf5.Close
    
    Exit Sub
    
SubError:
    MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
    "An error occurred"
    Err.Clear
    Resume SubExit
    
End Sub

I would like to have the loops somewhere else to make my code lighter, how can I do it?

Would it be enough with creating a module for each one in the database and call it from the code? How can I do this?

Thanks

 

[Gasman]

You are STILL not dimming your variables/objects correctly

 

[Cris VS]

I posted the code to try to show the loops that I want to separate correctly but I didn't copy all the dimming parts - in fact I wrote notes on those lines to remark that some dimensionings are missing

Dim xlApp As Excel.Application
Dim xlWorkbook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Dim db As DAO.Database
Dim qdf1 As DAO.QueryDef
Dim rs1 As DAO.Recordset
Dim nrow, rowcount, lastrow As Long
Dim x,y,adr as string

On Error GoTo SubError
DoCmd.Hourglass True
    
    Set db = CurrentDb()
    
    'Event name:
    Set qdf1 = db.QueryDefs("QueryEvent")
    qdf1!ParEvent = [Forms]![EventForm]![Event]
    Set rs1 = qdf1.OpenRecordset
    If rs1.RecordCount = 0 Then
        MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
        GoTo SubExit
    End If
    
    Set xlApp = Excel.Application
    
    xlApp.Visible = False
    xlApp.DisplayAlerts = False
    
        Set xlWorkbook = xlApp.Workbooks.Add
        Set xlSheet = xlWorkbook.Worksheets(1)
                
        With xlSheet
            
            'GENERAL FORMATTING
            .Name = "Event Summary"
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = 10
            .Cells.VerticalAlignment = xlCenter
            .Columns.WrapText = False
            .Columns.ColumnWidth = 10
            .Cells.Interior.Color = RGB(255, 255, 255)
                                  
            'Print setup
            .PageSetup.Orientation = xlLandscape
            .PageSetup.FitToPagesWide = 1
            .PageSetup.PaperSize = xlPaperA4
            .PageSetup.Zoom = 40
            
            'With loop that gets repeated
            With .Columns("K")
                .ColumnWidth = 17
                .HorizontalAlignment = xlCenter
                .FormatConditions.Add(xlCellValue, xlEqual, "O").Interior.Color = RGB(38, 250, 58)
                .FormatConditions.Add(xlCellValue, xlEqual, "OG").Interior.Color = RGB(0, 176, 80)
                .FormatConditions.Add(xlCellValue, xlEqual, "F").Interior.Color = RGB(192, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(246, 134, 206)
                .FormatConditions.Add(xlCellValue, xlEqual, "N").Interior.Color = RGB(191, 191, 191)
                .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(255, 255, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "NT").Interior.Color = RGB(255, 192, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "NO").Interior.Color = RGB(255, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "W").Interior.Color = RGB(0, 176, 240)
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Interior.Color = RGB(0, 0, 0)
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Bold = True
                .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Color = RGB(255, 0, 0)
            End With
            
            'For loop that gets repeated
            If .Range("I" & rowcount).Value = "" Then
                .Range("C" & rowcount & ":O" & rowcount).Value = "No items"
                .Range("C" & rowcount & ":O" & rowcount).Merge
                .Range("C" & rowcount & ":O" & rowcount).HorizontalAlignment = xlLeft

            Else
                For nrow = rowcount To lastrow
                    y = .Cells(nrow, 2) & ""
                    
                    If Len(y) Then
                        If y = x Then
                            adr = .Cells(nrow - 1, 2).Address & ":" & .Cells(nrow, 2).Address
                            .Range(adr).Merge
                        End If
                    End If                     
                    x = y
                Next nrow
            End If
            
            'Other code'
            
            .Range("B2").Select
       End With

xlApp.ActiveWindow.Zoom = 75
xlApp.DisplayAlerts = True
xlApp.Visible = True

MsgBox "File exported successfully", vbInformation + vbOKOnly, "Export success"
          
SubExit:
    DoCmd.Hourglass False
    On Error Resume Next
    
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing

    Set db = Nothing
    
    Set rs1 = Nothing
    
    Set qdf1 = Nothing
    
    rs1.Close
    
    qdf1.Close
    
    Exit Sub
    
SubError:
    MsgBox "Error number: " & Err.Number & "*" & Err.Description, vbCritical + vbOKOnly, _
    "An error occurred"
    Err.Clear
    Resume SubExit
    
End Sub

This should work...

 

[The_Doc_Man]

MS Docs has this to say about "procedure too large":

Procedure too large

Office VBA reference topic

docs.microsoft.com

As to "how to break up procedures" the trick is to isolate functional sections within the procedure. Got something that iterates over a large number of items in a loop? Put the loop in a separate module and remember to pass in the item specification as a parameter to the subroutine. When the item is an OBJECT, such as an Excel workbook,, you can create the workbook in your main routine if you wish and then pass the object to a subroutine using the "ByRef" modifier (which is actually the default on objects anyway). Which means your subroutine will work on the "real" object by using the reference to it. Just remember that "Me.x" doesn't work in general modules because that is a contextual shortcut and, when you call something in a general module, you have left the context of your caller.

Breaking up something into parts is a generally good program design as well, because it forces you to organize your actions into logical units, each of which does a relatively simple and isolated action. This makes debugging and sight-checking and hand-tracing FAR easier.

 

[Minty]

If you are asking if you can make this repeat for columns K,L, M, N, etc , then the answer is yes.

   'With loop that gets repeated
            With .Columns("K")

You could put the columns in table and loop through them, or put them in an array and step through them, or you could pass the column into a procedure that repeats those settings per column passed in, which would break down the section of code into a separate process.
You would have to pass the workbook object and sheet in or declare them at the top of the local module so they aren't losing their scope.

 

[gemma-the-husky]

Why do you get a "procedure too large" error?
Can you tell?

 

[Cris VS]

Put the loop in a separate module and remember to pass in the item specification as a parameter to the subroutine. When the item is an OBJECT, such as an Excel workbook,, you can create the workbook in your main routine if you wish and then pass the object to a subroutine using the "ByRef" modifier (which is actually the default on objects anyway).

Hello, this sounds just like what I am looking to do but I am not sure how to as I am relatively new to VBA, could you explain how to do this or provide some kind of bibliography where I can find the details of this? Thank you

 

[Cris VS]

If you are asking if you can make this repeat for columns K,L, M, N, etc , then the answer is yes.

   'With loop that gets repeated
            With .Columns("K")

You could put the columns in table and loop through them, or put them in an array and step through them, or you could pass the column into a procedure that repeats those settings per column passed in, which would break down the section of code into a separate process.
You would have to pass the workbook object and sheet in or declare them at the top of the local module so they aren't losing their scope.

It is more related to rows but I guess it's the same procedure, but could someone specify a bit more how to do it please? Thanks

 

[Cris VS]

Why do you get a "procedure too large" error?
Can you tell?

Because my code consists in 4 blocks that are very similar and that use two or three loops that repeat exactly and that are quite large... so I was thinking that instead of having 4 blocks x 3 loops per block x 20 lines per loop I could call them, but I don't know how to do this call. I looked it up in the MS Support page but I have no idea how to start applying that "theory" to my code

 

[The_Doc_Man]

OK, perhaps the problem is actually a very common problem with younger or less experienced programmers. It is the old "forest for the trees" problem, which in other discussions has been called "alternation of attention" and "limited scope visualization." In order to be a really good programmer, this is ONE of many skills to develop. You need to be able to view things both in detail and in general / overall function. By analogy, to be a good car mechanic, you need to understand belts and nuts and bolts but you also need to understand how the alternator hooks up to things and feeds power to things.

Start by looking at your code, not line-by-line but chunk-by-chunk. Ask yourself "What does this chunk do?" Make dividers in your code to help you visualize this.

'-------------------------------------------------
'   This chunk adjusts color and formats for several columns

Now look through each blocked / separated section and see whether the code defines everything it needs in-line or whether you need something external. If you need no more than two or three external items and the rest is defined fully by the code, there is a candidate for separation into a subroutine. For example, look at your code that does this:

                For nrow = rowcount To lastrow
                    ye = .Cells(nrow, 2) & ""
                    ype = .Cells(nrow, 3) & ""
                    ypu= .Cells(nrow, 4) & ""
                    ys = .Cells(nrow, 5) & ""
                    yi = .Cells(nrow, 6) & ""
                    yt = .Cells(nrow, 13) & ""
                    
                    If Len(ye) Then
                        If ye = xe Then
                            adre = .Cells(nrow - 1, 2).Address & ":" & .Cells(nrow, 2).Address
                            .Range(adre).Merge
                        End If
                    End If
                    If ype = xpe And ye = xe Then
                        adrpe = .Cells(nrow - 1, 3).Address & ":" & .Cells(nrow, 3).Address
                        .Range(adrpe).Merge
                    End If
                    If ype = xpe And ye = xe And ypu = xpu Then
                        adrpu = .Cells(nrow - 1, 4).Address & ":" & .Cells(nrow, 4).Address
                        .Range(adrpu).Merge
                    End If
                   ...

Your code doesn't actually define values for rowcount and lastrow but if they mean what I think they mean, you can EITHER look them up or pass them in to the potential subroutine. Note that you are still using "WITH" syntax in that segment, so that means you would have to pass in the worksheet to the potential subroutine.

Here is another thing to look at... you have code that starts like this:

        Set xlSheet = xlWorkbook.Worksheets(1)
                
        With xlSheet
            
            'GENERAL FORMATTING

Rather than doing this in-line, make a subroutine in a general module.

Public Sub GeneralFmtg( ByRef xlS as Excel.Worksheet
    With xlX

            'GENERAL FORMATTING
            .Name = "Event Summary"
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = 10
            .Cells.VerticalAlignment = xlCenter
            .Columns.WrapText = False
            .Columns.ColumnWidth = 10
            .Cells.Interior.Color = RGB(255, 255, 255)
                                  
            'Print setup
            .PageSetup.Orientation = xlLandscape
            .PageSetup.FitToPagesWide = 1
            .PageSetup.PaperSize = xlPaperA4
            .PageSetup.Zoom = 40

...

Then, after you do that SET xlSHEET .... do

     GeneralFmtg xlSHEET

NOTE: I made the "ByRef" explicit because (a) I'm providing an example that SHOULD be explicit in the point and (b) besides that, if you get this working, put it aside for six months, and then have to come back to fix something, you'll see that and remember that you are working via pointer to the real worksheet (which is what ByRef REALLY means) rather than a copy of it (which is what ByVal would imply).

Finally, don't want to harp on something that others have mentioned, but this does not work as you think it would:

Dim rs1, rs2, rs3, rs4, rs5 As DAO.Recordset

This should be

Dim rs1 as DAO.Recordset
Dim rs2 as DAO.Recordset
Dim rs3 as DAO.Recordset
...

Your way ONLY defines rs5 as a DAO.Recordset; the other four rs variables are Variant data type. Which will work, but it defeats Intellisense to do it your way. If Intellisense sees something as a variant, that can be ANYTHING - which is nice to avoid run-time errors but harder to program. If you use the correct data type and it is a complex object (like a recordset), Intellisense "knows" the parts thereof and will help you fill in those parts if/when required.

Finally, DON'T FORGET: Going into a subroutine in a general module ABSOLUTELY precludes use of Me. and Me! constructs. They are based on physical / code-location context, not logical / code-execution-sequence context.

 

[gemma-the-husky]

do you actually get a procedure too large error? what is the actual error code?

Are you sure that isn't a coding error. I think this gives you an error if you have too many continuations in the code block. Maybe you are seeing the error for that reason.

strg = part1 & _
part2 &_
part3 & _
part4


you can replace the above with this to avoid that error.

strg = part1
strg = strg & part2
strg = strg & part3
strg = strg & part4

 

[sonic8]

@The_Doc_Man, very well done detailed explanation!

Just one remark for clarification:

you are working via pointer to the real worksheet (which is what ByRef REALLY means) rather than a copy of it (which is what ByVal would imply).

With object variables ByRef/ByVal will decide whether the original pointer or a copy of the pointer value is passed to the procedure. Regardless what you choose, the pointer will still point to the very same original object.

 

[MajP]

There are other things that can cause this error because I find it hard to believe that your code is really 64K when compiled. I imagine you would have to have a few thousand lines of code. Do you really.

Here is a couple of examples. When I write a procedure, each procedure usually does only one thing. I try to make each reusable, and you do that by passing in parameters to the procedure. I did a little of the first part

Public Function GetNewXLSheet() as excel.worksheet
  Dim xlApp As Excel.Application 
  Dim xlWorkbook As Excel.Workbook
  Dim xlSheet As Excel.Worksheet
 
  Set xlApp = Excel.Application
  xlApp.Visible = False
  xlApp.DisplayAlerts = False
  Set xlWorkbook = xlApp.Workbooks.Add
  Set xlSheet = xlWorkbook.Worksheets(1)
 
  GetNewXlSheet = xlSheet
end function

Public Sub FormatSheet(xlSheet as excel.workSheet)
        With xlSheet
            
            'GENERAL FORMATTING
            .Name = "Event Summary"
            .Cells.Font.Name = "Calibri"
            .Cells.Font.Size = 10
            .Cells.VerticalAlignment = xlCenter
            .Columns.WrapText = False
            .Columns.ColumnWidth = 10
            .Cells.Interior.Color = RGB(255, 255, 255)
                                  
            'Print setup
            .PageSetup.Orientation = xlLandscape
            .PageSetup.FitToPagesWide = 1
            .PageSetup.PaperSize = xlPaperA4
            .PageSetup.Zoom = 40
        end with
End sub

Public Sub FormatColumn(col as excel.column)
  with col
    .ColumnWidth = 17
    .HorizontalAlignment = xlCenter
    .FormatConditions.Add(xlCellValue, xlEqual, "O").Interior.Color = RGB(38, 250, 58)
    .FormatConditions.Add(xlCellValue, xlEqual, "OG").Interior.Color = RGB(0, 176, 80)
    .FormatConditions.Add(xlCellValue, xlEqual, "F").Interior.Color = RGB(192, 0, 0)
    .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(246, 134, 206)
    .FormatConditions.Add(xlCellValue, xlEqual, "N").Interior.Color = RGB(191, 191, 191)
    .FormatConditions.Add(xlCellValue, xlEqual, "T").Interior.Color = RGB(255, 255, 0)
    .FormatConditions.Add(xlCellValue, xlEqual, "NT").Interior.Color = RGB(255, 192, 0)
    .FormatConditions.Add(xlCellValue, xlEqual, "NO").Interior.Color = RGB(255, 0, 0)
    .FormatConditions.Add(xlCellValue, xlEqual, "W").Interior.Color = RGB(0, 176, 240)
    .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Interior.Color = RGB(0, 0, 0)
    .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Bold = True
    .FormatConditions.Add(xlCellValue, xlEqual, "Ng").Font.Color = RGB(255, 0, 0)
  end with
End sub

-----------------------------------  See what was removed.
dim xlSheet as excel.worksheet
Dim db As DAO.Database
Dim qdf1, qdf2, qdf3, qdf4, qdf5 As DAO.QueryDef
Dim rs1, rs2, rs3, rs4, rs5 As DAO.Recordset
Dim nrow, rowcount, lastrow As Long 'And other strings like x,y,adr

On Error GoTo SubError
DoCmd.Hourglass True
    
    Set db = CurrentDb()
    
    'Event name:
    Set qdf1 = db.QueryDefs("QueryEvent")
    qdf1!ParEvent = [Forms]![EventForm]![Event]
    Set rs1 = qdf1.OpenRecordset
    If rs1.RecordCount = 0 Then
        MsgBox "No data available for export", vbInformation + vbOKOnly, "Excel not launched"
        GoTo SubExit
    End If
    
    set XlSheet = getNewXLSHeet()
    formatSheet xlSheet
    
     'Some loop here for each column
      dim col as xl.column
      set Col = xlSheet.column("k")
      FormatCol Col         

            
            'For loop that gets repeated
            If .Range("I" & rowcount).Value = "" Then
                .Range("C" & rowcount & ":O" & rowcount).Value = "No items"
                .Range("C" & rowcount & ":O" & rowcount).Merge
                .Range("C" & rowcount & ":O" & rowcount).HorizontalAlignment = xlLeft

 

[The_Doc_Man]

@The_Doc_Man, very well done detailed explanation!

Just one remark for clarification:

With object variables ByRef/ByVal will decide whether the original pointer or a copy of the pointer value is passed to the procedure. Regardless what you choose, the pointer will still point to the very same original object.

According to at least some references I have found, passing an object by value CAN occur and results in copying the object. What happens after that depends on the nature of the object. If it is, for example, an Excel object that is already opened, both the original and copy point to the same workbook file, so have no effect in the long run - except possibly if the copied Excel object causes Excel to stay open when you tend to the original object. For recordset objects, the stack cleanup associated with exiting the called routine destroys the recordset object and, since it didn't trigger an external "thing" its remnants should no longer exist.

Unfortunately, the VBA Language Reference (which can be found online - if you search for "VBA Language Reference", obviously) is ambiguous about what happens when an object is passed by value. It IS clear that a copy of the object variable is made - but is unclear whether that copy includes regeneration of a procedure-local copy of the implied object. However, for strings - which are actually NOT considered scalars, but rather are structures - the string descriptor AND ITS DESCRIBED STRING are both copied.

 

[MajP]

According to at least some references I have found, passing an object by value CAN occur and results in copying the object

If they are suggesting that the object is deep clooned, then please provide a link to any reference that shows that, I do not believe such exist. Passing by val does one and only one thing and makes a copy of the pointer

With object variables ByRef/ByVal will decide whether the original pointer or a copy of the pointer value is passed to the procedure.

Clearly according to MS

For reference types, only the pointer to the data is copied (four bytes on 32-bit platforms, eight bytes on 64-bit platforms). Therefore, you can pass arguments of type String or Object by value without harming performance

 

[sonic8]

According to at least some references I have found, passing an object by value CAN occur and results in copying the object.

Sorry to cut you short here, but these references are wrong.

What happens after that depends on the nature of the object.

Not really.
The relevant "nature of the object" in this context is it being a COM object, which applies to all objects you can use as such within VBA.
When an object is created or the reference being copied to another variable (be it explicitly or implicitly by passing it ByVal to another procedure) will only increment its reference count. Vice versa setting an object variable to Nothing or the variable going out of scope will decrement its reference count. The actual object itself is only "destroyed" once there are no more references to it.

The following code might help illustrating the mechanisms:

Public Sub MainProc()
   
    Dim dbEng As Object
    Set dbEng = New DBEngine
   
    Debug.Print "MainProc ObjPtr (after creation): " & ObjPtr(dbEng)
   
    ChildProcByValToNothing dbEng
    Debug.Print "MainProc ObjPtr (after ChildProcByValToNothing): " & ObjPtr(dbEng)
   
    ChildProcByRef dbEng
    Debug.Print "MainProc ObjPtr (after ChildProcByRef): " & ObjPtr(dbEng)
   
    ChildProcByRefToNothing dbEng
    Debug.Print "MainProc ObjPtr (after ChildProcByRefToNothing): " & ObjPtr(dbEng) & _
            vbCrLf & "Pointer now = 0 because the last/only object reference was set to Nothing in ChildProcByRefToNothing."
   
End Sub

Public Sub ChildProcByValToNothing(ByVal someObject As Object)
    Debug.Print "ChildProcByVal  ObjPtr: " & ObjPtr(someObject)
    Set someObject = Nothing
End Sub

Public Sub ChildProcByRef(ByRef someObject As Object)
    Debug.Print "ChildProcByRef  ObjPtr: " & ObjPtr(someObject)
End Sub

Public Sub ChildProcByRefToNothing(ByRef someObject As Object)
    Debug.Print "ChildProcByRef  ObjPtr: " & ObjPtr(someObject)
    Set someObject = Nothing
End Sub

I choose DbEngine as object type because it can be instantiated without much fuss. Feel free to adapt the code for any type of object you like, it will not change the outcome.

 

[sonic8]

Passing by val does one and only one thing and makes a copy of the pointer

@MajP, your statement is correct. Unfortunately, you underpinned it with non-applicable quotes from the VB.Net reference.

 

[The_Doc_Man]

I will step back from this to see if I can find the references.

However, I will also state that this behavior is nonsensical since the purpose of ByVal is to protect the thing being passed.

 

[The_Doc_Man]

I went back to what should be a definitive source. Never mind articles in forums.

My reference is the Microsoft VBA Language Reference, dated 4/24/2014.
In chapter 5, Module Bodies, one can find
section 5.3, Module Code Section Structure, in which one can find
section 5.3.1, Procedure Declarations, which eventually leads to
section 5.3.1.11, Procedure Invocation Argument Processing

The introduction to that section talks about how to validate the actual arguments such that they correspond to the formal arguments. The part that matters follows the sub-heading "Runtime Semantics."

After wading through several paragraphs, ...

If the parameter has no argument mapped to it, the parameter is ByVal, or the parameter is ByRef and the mapped argument’s expression is classified as a value, function, property or unbound member, a local variable is defined with procedure extent within the procedure being invoked with the same name value and declared type as the parameter, and has its value assigned as follows:

<skipping two bulleted items that do not apply>

Otherwise, if the value type of this parameter’s mapped argument is a specific class or Nothing, the argument’s data value is Set-assigned to the new local variable.

When you look up Set-assignment, the action (in summary and omitting a discussion of the With Events option) says it determines the value implied by the right-hand side of the assignment and copies that to the left-hand side of the assignment. (This is an approximation of what it actually says, which gets pretty abstract.) In essence, if the variable is an object, it is evaluated to form a single value (which can ONLY be the address of the object in memory) and that value is bounced into the copy of the procedure-local parameter as created by the ByVal semantics.

So, I'll admit that I must have read an incorrect reference some time ago and it stuck with me. Sorry if I mislead anyone, but I was mislead myself.