File Size Increasing Dramatically every click!
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:
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:
Code:
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
Re: File Size Increasing Dramatically every click!
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!
