File Size Increasing Dramatically every click!

[vjmehra]

I have some code that fires on a button press, which deletes any existing buttons, then adds a series of new buttons. I'm not 100% sure this is what is causing the file size to increase dramatically every time the initial button is clicked, but it seems likely.

The odd thing is, I've checked and the deleted buttons are no longer there (I checked with code, rather than simply visually checking they weren't there), so I can't see why the file would be so large.

Is anyone able to see anything I've missed here:

Button click code:

Private Sub btnsearch_Click()

Dim Start_Row As Integer
Start_Row = 5

Del = Delete_Rows(Start_Row)

Set cn = create_connection()

Set rs = open_recordset("call sp_filter_issues_reduced_view(" & _
ActiveSheet.cbsub_sector & "," & _
"'" & ActiveSheet.tbdescription & "%'," & _
IIf(ActiveSheet.cbcurrency.Value = "0", "NULL", ActiveSheet.cbcurrency.Value) & "," & _
IIf(ActiveSheet.cbcountry.Value = "0", "NULL", ActiveSheet.cbcountry.Value) & ");", cn, "A5")

cn.Close
Set cn = Nothing

Add = Add_Button(Start_Row)

End Sub

Everything else:

Public cn As ADODB.Connection
Public rs As ADODB.Recordset
Public My_Array
Public Field_Count As Integer

Public Function create_connection() As ADODB.Connection

Server_Name = "xxx"
Database_Name = "xxx"
User_ID = "xxx"
Password = "xxx"

Set cn = New ADODB.Connection
   cn.Open "Driver={MySQL ODBC 5.2a Driver};Server=" & Server_Name & ";Database=" & Database_Name & _
    ";Uid=" & User_ID & ";Pwd=" & Password & ";"
    
Set create_connection = cn

End Function

Public Function cb_open_recordset(SQL_String As String, Database_Connection As ADODB.Connection, Field_ID As Integer, Field_Name As Integer, _
Column_Widths As String, First_Value As String, Combobox_Name As ComboBox, None_Selected As String) As ADODB.Recordset

If First_Value = "Yes" Then
List_index = 1
Else
List_index = -1
End If
  
Set rs = New ADODB.Recordset

rs.Open SQL_String, Database_Connection

Set cb_open_recordset = rs

Field_Count = rs.Fields.Count
My_Array = rs.GetRows()

With Combobox_Name
   .Clear
    .BoundColumn = Field_ID 'this uses the CustomerID as the field to save
    .TextColumn = Field_Name
    .ColumnWidths = Column_Widths
    .Column = My_Array 'Use this and the problem works even with 1 record!!
    .ListIndex = List_index
    .ColumnCount = Field_Count
End With

If None_Selected = "Yes" Then
With Combobox_Name
    .AddItem "0", 0
    .List(0, 2) = "None Selected"
    .ListIndex = 0
End With
Else

End If

rs.Close
Set rs = Nothing

End Function
Public Function open_recordset(SQL_String As String, Database_Connection As ADODB.Connection, Query_Start As String) As ADODB.Recordset

Set rs = New ADODB.Recordset

rs.Open SQL_String, Database_Connection

Set open_recordset = rs

Field_Count = rs.Fields.Count
My_Array = rs.GetRows()

kolumner = UBound(My_Array, 1)
rader = UBound(My_Array, 2)

For k = 0 To kolumner ' Using For loop data are displayed

Range(Query_Start).Offset(0, k).Value = rs.Fields(k).Name
For R = 0 To rader
 Range(Query_Start).Offset(R + 1, k).Value = My_Array(k, R)
Next
Next

rs.Close
Set rs = Nothing

End Function
Public Function Delete_Rows(Start_Row As Integer)

    last = Cells(Rows.Count, "a").End(xlUp).Row
    For i = last To Start_Row Step -1
        Cells(i, "A").EntireRow.Delete
             Next i
     
End Function
Public Function Add_Button(Start_Row As Integer)

Dim btn As Shape

For Each btn In ActiveSheet.Shapes
    If btn.AutoShapeType = xlButtonControl Then btn.Delete
Next

Start_Row = Start_Row + 1

last = Cells(Rows.Count, "a").End(xlUp).Row
    For i = last To Start_Row Step -1

Dim sShape As Shape
     
    With Range("B" & i)
        Set sShape = Sheet1.Shapes.AddFormControl _
        (Type:=xlButtonControl, Left:=.Left, Top:=.Top, Width:=.Width, Height:=.Height)
    End With
    With sShape
        .OnAction = "clickbutton"
        .Name = Cells(i, 1).Value
        With .TextFrame.Characters
            .Caption = Cells(i, 2).Value
        With .Font
                .Name = "Arial"
                .FontStyle = "Regular"
                .Size = 10
            End With
        End With
    End With

        Next i
        
ActiveSheet.Range(Cells(Start_Row - 1, 1), Cells(Rows.Count, "a")).Delete

ActiveSheet.Columns.AutoFit

'Loops through and deletes existing buttons
For Each objole In ActiveSheet.OLEObjects
        If TypeName(objole.Object) = "CommandButton" Then
          
          'Checks to ensure btnsearch is not deleted
          If objole.Name <> "btnsearch" Then
          
          'Deletes all buttons apart from btnsearch
                   objole.Width = ActiveSheet.Range("A5").Width
          
          End If
          
        End If
    Next objole
    
Dim LastCol As Integer
Dim LastRow As Integer
    With ActiveSheet
        LastCol = .Cells(Start_Row, .Columns.Count).End(xlToLeft).Column
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
'Add borders to cells
With ActiveSheet.Range(Cells(Start_Row - 1, 1), Cells(LastRow, LastCol)).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    
'Align text within cells
ActiveSheet.Range(Cells(Start_Row - 1, 1), Cells(LastRow, LastCol)).Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With
 
'Formats and re-names headers
ActiveSheet.Cells(Start_Row - 1, 1).Value = "Description"
ActiveSheet.Cells(Start_Row - 1, 2).Value = "CCY"
ActiveSheet.Cells(Start_Row - 1, 3).Value = "Call Date"
ActiveSheet.Cells(Start_Row - 1, 4).Value = "Maturity Date"
ActiveSheet.Cells(Start_Row - 1, 5).Value = "ISIN"
ActiveSheet.Cells(Start_Row - 1, 6).Value = "Moodys"
ActiveSheet.Cells(Start_Row - 1, 7).Value = "Fitch"
ActiveSheet.Cells(Start_Row - 1, 8).Value = "S & P"
ActiveSheet.Cells(Start_Row - 1, 9).Value = "Capital"
ActiveSheet.Cells(Start_Row - 1, 10).Value = "Bid Prc"
ActiveSheet.Cells(Start_Row - 1, 11).Value = "Ask Prc"
ActiveSheet.Cells(Start_Row - 1, 12).Value = "Bid Z"
ActiveSheet.Cells(Start_Row - 1, 13).Value = "Ask Z"
ActiveSheet.Cells(Start_Row - 1, 14).Value = "Bid Sprd"
ActiveSheet.Cells(Start_Row - 1, 15).Value = "Ask Sprd"
ActiveSheet.Cells(Start_Row - 1, 16).Value = "Bid YTC"
ActiveSheet.Cells(Start_Row - 1, 17).Value = "Ask YTC"
ActiveSheet.Cells(Start_Row - 1, 18).Value = "Bid YTM"
ActiveSheet.Cells(Start_Row - 1, 19).Value = "Ask YTM"
ActiveSheet.Cells(Start_Row - 1, 20).Value = "Price Date"
ActiveSheet.Cells(Start_Row - 1, 21).Value = "Price Time"
ActiveSheet.Cells(Start_Row - 1, 22).Value = "Price Source"
ActiveSheet.Cells(Start_Row - 1, 23).Value = "COD"
ActiveSheet.Cells(Start_Row - 1, 24).Value = "CFI"
ActiveSheet.Cells(Start_Row - 1, 25).Value = "Benchmark"
ActiveSheet.Cells(Start_Row - 1, 26).Value = "Price To"
ActiveSheet.Cells(Start_Row - 1, 27).Value = "Quote Convention"
ActiveSheet.Cells(Start_Row - 1, 28).Value = "Issue Price"
ActiveSheet.Cells(Start_Row - 1, 29).Value = "Issue Swap Sprd"
ActiveSheet.Cells(Start_Row - 1, 30).Value = "Issue Sprd"
ActiveSheet.Cells(Start_Row - 1, 31).Value = "Amt Issued"
ActiveSheet.Cells(Start_Row - 1, 32).Value = "Amt Out"

ActiveSheet.Range("A5:AF5").Interior.ColorIndex = 37
ActiveSheet.Range("A5:AF5").Font.Bold = True
ActiveSheet.Columns.AutoFit

End Function
Sub clickbutton()
 MsgBox (Application.Caller)
End Sub

[vjmehra]

Interestingly if I comment out the code to add the buttons, but run the rest, the file size doesn't grow, so this suggests my theory is correct.

That said it doesn't explain why the file size doesn't shrink without the buttons and how to stop it continually growing, once they are there!