Empty excel file has huge size

Question

I've been writing in vba some code to make excel open a workbook, get info from there, paste it temporarily in the file and use that data to make an e-mail and send it. After that he clears everything and an empty file is left.

Although there is nothing but one button (not an ActiveX control) and one userform in it the file is 27MB. While it was 400kb before. I don't know what has happened. Any ideas how to solve this and reduce it again? Because the file was made to reduce the time spend on sending e-mails but if it takes that long to open the file because it's that huge the time you win is very little and therefore it's not efficient anymore.

The program I use is Excel 2010.

Thanks in advance!

Code:

    Private Sub BtnGo_Click()
Dim i As Integer, j As Integer, k As Integer, l As Integer, LastRow, wb As Workbook, TargetBook As Workbook, Doc(500), Revision(500), DocName(500), UpdateDate(500)
Dim Tekst As String, DocType As String
Dim NietGevonden
Set TargetBook = ThisWorkbook
'Controleren of alles ingevuld is
If TxtNumberDoc.Text = "" Then
NietGevonden = MsgBox("Aantal doc niet ingegeven." & vbCrLf & "Gelieve opnieuw te proberen.", vbCritical, "# doc!")
Exit Sub
End If
If OptVincent.Value = False And OptRuben.Value = False Then
NietGevonden = MsgBox("Geen naam geselecteerd." & vbCrLf & "Gelieve opnieuw te proberen.", vbCritical, "Geen naam!")
Exit Sub
End If

TargetBook.ActiveSheet.Range("A:C").NumberFormat = "@"
TargetBook.ActiveSheet.Range("D:D").NumberFormat = "dd/mm/yyyy"
If OptVincent.Value = True Then
TargetBook.ActiveSheet.Range("G25").Value = "Vincent"
Else
TargetBook.ActiveSheet.Range("G25").Value = "Ruben"
End If

'Doc system openen
Set wb = Workbooks.Open("****")
'Juiste tablad openen
If OptQN.Value = True Then
wb.Sheets("DOC_QN").Activate
TargetBook.ActiveSheet.Range("G26").Value = "QN"
TargetBook.ActiveSheet.Range("G27").Value = "Quality Notes"
TargetBook.ActiveSheet.Range("G28").Value = "Quality Note"
GoTo Zoeken
End If

If OptQF.Value = True Then
wb.Sheets("DOC_QF").Activate
TargetBook.ActiveSheet.Range("G26").Value = "QF"
TargetBook.ActiveSheet.Range("G27").Value = "Quality Forms"
TargetBook.ActiveSheet.Range("G28").Value = "Quality Form"
GoTo Zoeken
End If

If OptQAP.Value = True Then
wb.Sheets("DOC_QAP").Activate
TargetBook.ActiveSheet.Range("G26").Value = "QAP"
TargetBook.ActiveSheet.Range("G27").Value = "Quality Assurance Plans"
TargetBook.ActiveSheet.Range("G28").Value = "Quality Assurance Plan"
GoTo Zoeken
End If

If OptQL.Value = True Then
wb.Sheets("DOC_QL").Activate
TargetBook.ActiveSheet.Range("G26").Value = "QL"
TargetBook.ActiveSheet.Range("G27").Value = "Quality Lists"
TargetBook.ActiveSheet.Range("G28").Value = "Quality List"
GoTo Zoeken
End If

If OptQCP.Value = True Then
wb.Sheets("DOC_QCP").Activate
TargetBook.ActiveSheet.Range("G26").Value = "QCP"
TargetBook.ActiveSheet.Range("G27").Value = "Quality Customer Plans"
TargetBook.ActiveSheet.Range("G28").Value = "Quality Customer Plan"
GoTo Zoeken
End If

If OptPF.Value = True Then
wb.Sheets("DOC_PF").Activate
TargetBook.ActiveSheet.Range("G26").Value = "PF"
TargetBook.ActiveSheet.Range("G27").Value = "Process Forms"
TargetBook.ActiveSheet.Range("G28").Value = "Proces Form"
GoTo Zoeken
End If

If OptPL.Value = True Then
wb.Sheets("DOC_PL").Activate
TargetBook.ActiveSheet.Range("G26").Value = "PL"
TargetBook.ActiveSheet.Range("G27").Value = "Process Lists"
TargetBook.ActiveSheet.Range("G28").Value = "Process List"
GoTo Zoeken
End If

If OptOPM.Value = True Then
wb.Sheets("DOC_OPM").Activate
TargetBook.ActiveSheet.Range("G26").Value = "OPM"
TargetBook.ActiveSheet.Range("G27").Value = "Operation Manuals"
TargetBook.ActiveSheet.Range("G28").Value = "Operation Manual"
GoTo Zoeken
End If

If OptTS.Value = True Then
wb.Sheets("DOC_TSY").Activate
TargetBook.ActiveSheet.Range("G26").Value = ""
TargetBook.ActiveSheet.Range("G27").Value = "Training Syllabis"
TargetBook.ActiveSheet.Range("G28").Value = "Training Syllabi"
GoTo Zoeken
End If

If OptREx.Value = True Then
wb.Sheets("DOC_REX").Activate
TargetBook.ActiveSheet.Range("G26").Value = "REx"
TargetBook.ActiveSheet.Range("G27").Value = "Retour d'Expériences"
TargetBook.ActiveSheet.Range("G28").Value = "Retour d'Expérience"
GoTo Zoeken
End If

If OptTC.Value = True Then
wb.Sheets("DOC_TrC").Activate
TargetBook.ActiveSheet.Range("G26").Value = ""
TargetBook.ActiveSheet.Range("G27").Value = "Training Courses"
TargetBook.ActiveSheet.Range("G28").Value = "Training Course"
GoTo Zoeken
End If

Zoeken:
'Bepalen hoeveel doc er gevraagd zijn
i = TxtNumberDoc.Text
For j = 1 To i
Doc(j) = InputBox(TargetBook.ActiveSheet.Range("G26").Value & " #?" & vbCrLf & "Number only.", "Insert Doc number")
Next j
j = 1
k = 5 'rij met eerste nummer
l = 1 'rijnummer targetbook
LastRow = wb.ActiveSheet.Range("C5").End(xlDown).Row

'data overzetten
DocType = TargetBook.ActiveSheet.Range("G28").Value
Do
If wb.ActiveSheet.Range("B" & k).RowHeight <> 0 Then
    Tekst = wb.ActiveSheet.Range("C" & k).Value
    If Doc(j) = Tekst Then
    TargetBook.ActiveSheet.Range("A" & l).Value = Doc(j)
    TargetBook.ActiveSheet.Range("B" & l).Value = wb.ActiveSheet.Range("D" & k).Value
    TargetBook.ActiveSheet.Range("C" & l).Value = wb.ActiveSheet.Range("E" & k).Value
    TargetBook.ActiveSheet.Range("D" & l).Value = wb.ActiveSheet.Range("F" & k).Value
    j = j + 1
    l = l + 1
    k = 5
    Else
    k = k + 1
    End If
Else
k = k + 1
End If
If j = i + 1 Then GoTo Vervolg 'Vervroegd laten stoppen als alles gevonden is
Loop Until k = LastRow + 1
'Als Doc niet gevonden is =>
NietGevonden = MsgBox(DocType & " " & Doc(j) & " niet gevonden." & vbCrLf & "Wil u de actie afbreken?" & vbCrLf & _
"(bij nee zal deze " & DocType & " overgeslagen worden.)", vbYesNo + vbExclamation + vbDefaultButton2, "Error, " & DocType & " " & Doc(j) & " niet gevonden.")
If NietGevonden = vbYes Then
wb.Close False
ActiveWorkbook.ActiveSheet.Range("A:G").Clear
Exit Sub
Else
j = j + 1
k = 5
GoTo Zoeken
End If


Vervolg:
wb.Close False
Me.Hide
SendMail
End Sub

Code 2:

Dim OutApp As Object
Dim OutMail As Object
Dim ontvanger As String
Dim Titel As String
Dim Name As String
Dim Signature As String
Dim LastRow As Integer
Dim i As Integer
Dim InhoudDoc As String
Dim InhoudMail As String
Dim Datum As String
Dim Maand As String
Dim Dag As String
Dim Jaar As String
Dim CheckDag As String
Dim Enkelvoud As String
Dim Meervoud As String
Dim Afkorting As String

Enkelvoud = ActiveWorkbook.ActiveSheet.Range("G28").Value
Meervoud = ActiveWorkbook.ActiveSheet.Range("G27").Value
Afkorting = ActiveWorkbook.ActiveSheet.Range("G26").Value
LastRow = ActiveWorkbook.ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
ontvanger = "#D_SSB UsersList"

Name = ActiveWorkbook.ActiveSheet.Range("G25").Value
'Signature namaken
Select Case Name
Case Is = "Vincent"
Signature = ****
Case Else
Signature = ****
End Select

If LastRow > 1 Then
Titel = "Please be informed that several new " & Meervoud & " have been accepted and published on Documentary System.xlsm (located on ****)."
For i = 1 To LastRow
    'Eerst datum samenstellen
    Datum = ActiveWorkbook.ActiveSheet.Range("D" & i).Value
    Dag = Left(Datum, 2)
    If Right(Dag, 1) = "/" Then
    Datum = Left(Datum, 4)
    Dag = "0" & Left(Dag, 1)
    Else
    Datum = Left(Datum, 5)
    End If
    Datum = Right(Datum, 2)
    Select Case Datum
    Case Is = "01"
    Maand = "January"
    Case Is = "02"
    Maand = "February"
    Case Is = "03"
    Maand = "March"
    Case Is = "04"
    Maand = "April"
    Case Is = "05"
    Maand = "May"
    Case Is = "06"
    Maand = "June"
    Case Is = "07"
    Maand = "July"
    Case Is = "08"
    Maand = "August"
    Case Is = "09"
    Maand = "September"
    Case Is = "10"
    Maand = "October"
    Case Is = "11"
    Maand = "November"
    Case Is = "12"
    Maand = "December"
    End Select
    Datum = ActiveWorkbook.ActiveSheet.Range("D" & i).Value
    Jaar = "20" & Right(Datum, 2)
InhoudDoc = InhoudDoc & Afkorting & ActiveWorkbook.ActiveSheet.Range("A" & i).Value & " Revision " & ActiveWorkbook.ActiveSheet.Range("B" & i) & _
" Dated " & Maand & " " & Dag & ", " & Jaar & ": " & "<b>" & ActiveWorkbook.ActiveSheet.Range("C" & i).Value & "</b>" & "<br>"
Next i
Else
  'Eerst datum samenstellen
    Datum = ActiveWorkbook.ActiveSheet.Range("D1").Value
    Dag = Left(Datum, 2)
    If Right(Dag, 1) = "/" Then
    Datum = Left(Datum, 4)
    Dag = "0" & Left(Dag, 1)
    Else
    Datum = Left(Datum, 5)
    End If
    Datum = Right(Datum, 2)
    Select Case Datum
    Case Is = "01"
    Maand = "January"
    Case Is = "02"
    Maand = "February"
    Case Is = "03"
    Maand = "March"
    Case Is = "04"
    Maand = "April"
    Case Is = "05"
    Maand = "May"
    Case Is = "06"
    Maand = "June"
    Case Is = "07"
    Maand = "July"
    Case Is = "08"
    Maand = "August"
    Case Is = "09"
    Maand = "September"
    Case Is = "10"
    Maand = "October"
    Case Is = "11"
    Maand = "November"
    Case Is = "12"
    Maand = "December"
    End Select
    Datum = ActiveWorkbook.ActiveSheet.Range("D1").Value
    Jaar = "20" & Right(Datum, 2)
Titel = "Please be informed that " & Enkelvoud & " " & Afkorting & " " & ActiveWorkbook.ActiveSheet.Range("A" & 1).Value & " has been revised, accepted and published on Documentary System.xlsm (located on ****)."
InhoudDoc = Afkorting & ActiveWorkbook.ActiveSheet.Range("A" & 1).Value & " Revision " & ActiveWorkbook.ActiveSheet.Range("B" & 1) & _
" Dated " & Maand & " " & Dag & ", " & Jaar & ": " & "<b>" & ActiveWorkbook.ActiveSheet.Range("C" & 1).Value & "</b>" & "<br>"
End If

InhoudMail = "<p>" & "Dear all" & "</p>" & "<p>" & Titel & "</p>" & "<br>" & "<p>" & InhoudDoc & "</p>" & "<br>" & "Best regards, " & "<br>" & Name & "<br>" & "<br>" & Signature
With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


With OutMail
    .To = ontvanger
    .CC = ""
    .BCC = ""
    .Subject = Titel
    .HTMLBody = InhoudMail
    .Display
End With
On Error GoTo 0

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

ActiveWorkbook.ActiveSheet.Range("A:G").Value = ""
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Answer 1

Many times when I copy paste it will bring in formatted cells that need to be deleted not cleared. I would try deleting the cells rather than clearing them or you can end up with hundreds of thousands of lines that dont have any values in them but take up space.