VBA Macro: Each item of Loop increases in size?

[valverde311]

Hi there,

I have written a macro that copies cells in a column of spreadsheet (A) into a column in spreadsheet (B) and then saves off a copy of spreadsheet (A) and moves onto the next column in spreadsheet (B) and repeats the process.

Everythign works fine except for one thing - Each iteration of the loop increases in file size by about 50 kb. If I have 56 iterations, the last spreadsheets that are created have huge file sizes even though they are no different in appearance from the first spreadsheet.

The weird thing is this: If i open the workbook and save it again, the file size reduces to the original size - 400kb. Does anybody know where this phantom file size increase is coming from?

(I have set cutcopymode to false, btw)

Additionally, I clear out all the changing cells in spreadsheet (a) before filling them in with cells from the next column in (B).


Does anybody know why the file size would increase? Is there some history thats being captured by any chance?

 

[VoG]

I don't know but try posting your code using code tags

[code]
your code
[/code]

 

[valverde311]

Sub Macro1()
    
    Dim i As Integer
    Dim h As Integer
    Dim Inputs As Worksheet
    Dim Master As Worksheet
    
    Dim Col As Integer
    Application.ScreenUpdating = False
    Application.CutCopyMode = False
    
       
    Set Inputs = Workbooks("Inputs.xls").Sheets(1)
    Set Master = Workbooks("Master File.xls").Sheets(1)
    
    For Col = 1 To 11
    
        Sheets("Down").Visible = False
 
        Master.Unprotect
        Master.Range("D1:D4").ClearContents
        Master.Range("D11:D45").ClearContents
        Master.Range("D48:D110").ClearContents
        Master.Range("D113:D136").ClearContents
        Master.Range("D139:D159").ClearContents
        Master.Range("D162:D183").ClearContents
        Master.Range("D186:D211").ClearContents
        Master.Range("D214:D239").ClearContents
        Master.Range("D242:D248").ClearContents
        Master.Range("D251:D314").ClearContents
        Master.Range("D317:D340").ClearContents
        Master.Range("D343:D367").ClearContents
        Master.Range("D372").ClearContents
        
                'All LOB
        
        For i = 2 To 5
                Inputs.Cells(i, Col).Copy
                Master.Cells(i - 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
         
        For i = 6 To 30
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 6, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
                                 
        For i = 31 To 35
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 7, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        
        For i = 36 To 36
           
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 7, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        
        Next i
        
        
'For Property
        For i = 39 To 60
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 9, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
             
        For i = 70 To 91
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 18, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
          
'For GL
        For i = 94 To 112
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 19, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        

'For Auto
        For i = 115 To 127
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 24, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        
        For i = 128 To 129
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 28, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
             
        For i = 131 To 132
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        
'For GL
        For i = 135 To 156
            
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
'Umbrella
        For i = 159 To 180
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        For i = 182 To 184
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 26, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
'TPG
        For i = 187 To 221
             
             If i >= 187 And i <= 212 Then
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
             End If
            If i >= 215 And i <= 221 Then
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
             End If
             
        Next i
        
'Inland Marine
        For i = 224 To 236
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 27, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
        For i = 237 To 242
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 28, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
             
        For i = 243 To 244
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 30, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
             
        For i = 245 To 245
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 31, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next
             
        For i = 246 To 247
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 32, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
                          
        For i = 248 To 249
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 33, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
             
        For i = 250 To 270
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 34, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
                         
 
        For i = 271 To 271
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 36, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
'Ocean Marine
        For i = 274 To 297
            
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 43, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
'Construction
        For i = 300 To 324
            
                Inputs.Cells(i, Col).Copy
                Master.Cells(i + 43, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Next i
                
                Master.Shapes("Check Box 10").ControlFormat.Value = False
 'Agreement
           
           
           
Master.Cells(37, 4).Value = "Refer All"
Master.Cells(44, 4).Value = "Refer All"
           
Master.Cells(71, 4).Value = "Refer All"
Master.Cells(72, 4).Value = "Decline"
Master.Cells(73, 4).Value = "Refer All"
Master.Cells(75, 4).Value = "Refer All"
Master.Cells(76, 4).Value = "Refer All"
Master.Cells(79, 4).Value = "Refer All"
Master.Cells(83, 4).Value = "Refer All"
Master.Cells(84, 4).Value = "Refer All"
Master.Cells(132, 4).Value = "Refer All"
Master.Cells(152, 4).Value = "Refer All"
Master.Cells(211, 4).Value = "Refer All"
Master.Cells(58, 4).Value = ""
Master.Cells(97, 4).Value = ""
Master.Cells(98, 4).Value = ""
Master.Cells(99, 4).Value = ""
Master.Cells(295, 4).Value = ""
Master.Cells(284, 4).Value = ""
      
      
      
      
      If Master.Cells(2, 4).Value = "Key Accounts" Then
      Call Key_Accounts
      End If
      
      If Master.Cells(2, 4).Value = "Tech Practice Group" Then
      Call TPG_Only
      End If
      
      If Master.Cells(2, 4).Value = "Specialty Construction" Then
      Call SP_Cst
      End If
      
      If Master.Cells(2, 4).Value = "Marine" Then
      Call Marine_Only
      End If
      
      Master.Protect
      
      Application.CutCopyMode = True
      
      Workbooks("Master File.xls").SaveCopyAs "C:\Test\" & GetFilenameFromPath(Inputs.Cells(1, Col).Value)
     
     Next Col
     
    
    Application.ScreenUpdating = True
End Sub
 
 
Function GetFilenameFromPath(ByVal strPath As String) As String
' Returns the rightmost characters of a string upto but not including the rightmost '\'
' e.g. 'c:\winnt\win.ini' returns 'win.ini'
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function