File size grows after running sub

Question

I'm working on a calendar and am trying to create a sub that automatically fills in each of the weeks in the year in the corresponding month-sheet. The week format and content is copied by

 firstRange.Copy Destination:=secondRange

from a hidden excel sheet and then, the dates and a title are put in with

 Call secondRange.Replace("Sometext", Weekdate)

The problem is that everytime I use this function the size of my excel sheet increases approximately 4KB. This is not too problematic, since the Sub will be used only around once a year, but I've had similar problems before where the filesize increased dramatically, usually when deleting rows or columns with VBA.

Is there something I need to change, or is it just some problem with Excel that I have to live with? Below the full sub (in a mix between English and German)

Public Sub newYear(Optional dasJahr As Integer = 0)

    If dasJahr = 0 Then dasJahr = getYear() ' Nimmt Constant thisYear falls nichts anderes spezifiziert ist. 

    ' Auschalten von Events
    Application.EnableEvents = False

    ' Löschen der Inhalte auf den Monatsblättern
    Worksheets("Januar").Cells.ClearContents
    Worksheets("Februar").Cells.ClearContents
    Worksheets("März").Cells.ClearContents
    Worksheets("April").Cells.ClearContents
    Worksheets("Mai").Cells.ClearContents
    Worksheets("Juni").Cells.ClearContents
    Worksheets("Juli").Cells.ClearContents
    Worksheets("August").Cells.ClearContents
    Worksheets("September").Cells.ClearContents
    Worksheets("Oktober").Cells.ClearContents
    Worksheets("November").Cells.ClearContents
    Worksheets("Dezember").Cells.ClearContents

    Dim Montag As Date
    Dim Neujahr As Date: Neujahr = DateValue("1.1." & dasJahr)

    Dim hoeheWoche As Integer: hoeheWoche = 69
    Dim breiteWoche As Integer: breiteWoche = 35

    Dim wsMnt As Worksheet: Set wsMnt = Worksheets("Januar")
    Dim wsVrlg As Worksheet: Set wsVrlg = Worksheets("Vorlage")

    Dim rDst As Range, rSrc As Range
    ' Kopiervorlage als Source definieren
    Set rSrc = wsVrlg.Range(wsVrlg.Cells(1, 1), wsVrlg.Cells(hoeheWoche + 1, breiteWoche + 1))


    Montag = Neujahr - Weekday(Neujahr, vbTuesday)

    Dim wochenStartReihe As Integer: wochenStartReihe = 2

    Do While (Year(Montag) <= dasJahr)

        If getMonth(Montag - 1, dasJahr) <> getMonth(Montag, dasJahr) Then
            wochenStartReihe = 2
            Set wsMnt = Worksheets(getMonth(Montag, dasJahr))
        End If

        Set rDst = wsMnt.Range(wsMnt.Cells(wochenStartReihe, 2), wsMnt.Cells(wochenStartReihe + hoeheWoche, 2 + breiteWoche))

        ' Kopiert Inhalte und Format aus der Vorlage in das Monatsblatt
        rSrc.Copy Destination:=rDst

        ' Ersetzen der Wochentage mit Datum
        Call rDst.Replace("Woche X ausblenden", "Woche " & KWoche(Montag) & " ausblenden")
        Call rDst.Replace("Montag", Montag)
        Call rDst.Replace("Dienstag", Montag + 1)
        Call rDst.Replace("Mittwoch", Montag + 2)
        Call rDst.Replace("Donnerstag", Montag + 3)
        Call rDst.Replace("Freitag", Montag + 4)
        Call rDst.Replace("Samstag", Montag + 5)
        Call rDst.Replace("Sonntag", Montag + 6)

        ' Doppelte Auflistung der Wochen die in zwei Monaten liegen
        If (getMonth(Montag, dasJahr) <> getMonth(Montag + 6, dasJahr)) And (getMonth(Montag + 6, dasJahr) <> "Januar") Then

            Set wsMnt = Worksheets(getMonth(Montag + 6, dasJahr))
            wochenStartReihe = 2

            Set rDst = wsMnt.Range(wsMnt.Cells(wochenStartReihe, 2), wsMnt.Cells(wochenStartReihe + hoeheWoche, 2 + breiteWoche))

            rSrc.Copy Destination:=rDst

            Call rDst.Replace("Woche X ausblenden", "Woche " & KWoche(Montag) & " ausblenden")
            Call rDst.Replace("Montag", Montag)
            Call rDst.Replace("Dienstag", Montag + 1)
            Call rDst.Replace("Mittwoch", Montag + 2)
            Call rDst.Replace("Donnerstag", Montag + 3)
            Call rDst.Replace("Freitag", Montag + 4)
            Call rDst.Replace("Samstag", Montag + 5)
            Call rDst.Replace("Sonntag", Montag + 6)

        End If

        wochenStartReihe = wochenStartReihe + hoeheWoche + 3
        Montag = Montag + 7

    Loop

    ' Events wieder einschalten
    Application.EnableEvents = True

End Sub

Instead of `.Cells.ClearContents` perhaps try `.UsedRange.EntireRow.Delete Shift:=xlup`. But of course this depends on whether you have dependent formulas, or anything else that requires the cells not to be deleted. Clearing cells is different then deleting rows or columns, the space remains, and if new things are inserted, the space used expands accordingly. — Demetri, Jan 12 '16 at 18:19
Thank you very much, Demitri. This seems to work almost perfectly. In 50 iterations the file size still increased, but only minimally (less than 0.5KB per iteration). — swit, Jan 13 '16 at 12:51

File size grows after running sub

0 Answers0