File size bloated after running macro... how can i fix?

N

nutritiouspig

Well-known Member
Joined
Jan 8, 2003
Messages
615
As an example, I just ran the macro shown below on 6 worksheets that averaged 40 rows and 21 columns of information. What starts out as a workbook with much less than 1MB of data, turns out to be over 8MB of data. Is there anything that pops out to you experts (besides my sloppy code) which could be improved?

Thanks!

Code: 
Sub Glendale_Format()
'
'
'

    Dim lastrow As Integer
    Dim lastrow2 As Integer
    lastrow = Range("A65536").End(xlUp).Row + 0
    lastrow2 = Range("A65536").End(xlUp).Row + 1
    lastrow3 = Range("A65536").End(xlUp).Row + 2
    lastrow5 = Range("A65536").End(xlUp).Row + 4
    lastrow6 = Range("A65536").End(xlUp).Row + 5
    lastrow7 = Range("A65536").End(xlUp).Row + 6
    lastrow8 = Range("A65536").End(xlUp).Row + 7
    lastrow10 = Range("A65536").End(xlUp).Row + 9
    lastrow11 = Range("A65536").End(xlUp).Row + 10
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Columns("F:F").Insert Shift:=xlToRight
    Range("F3").FormulaR1C1 = "Avail %"
    Range("E3").FormulaR1C1 = "Magic Avail %"
    Range("G3").FormulaR1C1 = "Occ. %"
    Range("A4").Value = Range("B2").Value
    
    Range("C4:BB65536").NumberFormat = "0.00"
    Columns("H:V").Delete Shift:=xlToLeft
    Range("N:N,S:AL").Delete Shift:=xlToLeft
    Range("R3") = "Total Occupied Time"
    Range("R4:R5000").FormulaR1C1 = "=IF(RC[-7]="""","""",(SUM(RC[-7]:RC[-1])))"
    Range("F4:F5000").FormulaR1C1 = "=IF(RC[2]="""","""",RC[3]/RC[2])"
    Range("C4:C5000").FormulaR1C1 = "=IF(RC[-1]="""","""",RC[15]/RC[-1])"
    
    Columns("H:U").Insert Shift:=xlToRight
    
    Range("H4:H5000").FormulaR1C1 = "=IF(RC[17]="""","""",RC[17]/RC[24])"
    Range("I4:I5000").FormulaR1C1 = "=IF(RC[16]="""","""",RC[16]/RC[-7])"
    Range("J4:J5000").FormulaR1C1 = "=IF(RC[16]="""","""",RC[16]/RC[22])"
    Range("K4:K5000").FormulaR1C1 = "=IF(RC[15]="""","""",RC[15]/RC[-9])"
    Range("L4:L5000").FormulaR1C1 = "=IF(RC[15]="""","""",RC[15]/RC[20])"
    Range("M4:M5000").FormulaR1C1 = "=IF(RC[14]="""","""",RC[14]/RC[-11])"
    Range("N4:N5000").FormulaR1C1 = "=IF(RC[14]="""","""",RC[14]/RC[18])"
    Range("O4:O5000").FormulaR1C1 = "=IF(RC[13]="""","""",RC[13]/RC[-13])"
    Range("P4:P5000").FormulaR1C1 = "=IF(RC[13]="""","""",RC[13]/RC[16])"
    Range("Q4:Q5000").FormulaR1C1 = "=IF(RC[12]="""","""",RC[12]/RC[-15])"
    Range("R4:R5000").FormulaR1C1 = "=IF(RC[12]="""","""",RC[12]/RC[14])"
    Range("S4:S5000").FormulaR1C1 = "=IF(RC[11]="""","""",RC[11]/RC[-17])"
    Range("T4:T5000").FormulaR1C1 = "=IF(RC[11]="""","""",RC[11]/RC[12])"
    Range("U4:U5000").FormulaR1C1 = "=IF(RC[10]="""","""",RC[10]/RC[-19])"
    
    
    Range("H2:I2").Merge
    Range("H2:I2").FormulaR1C1 = "Talk Time"
    Range("H3").FormulaR1C1 = "% of Occupied"
    Range("I3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("J2:K2").Merge
    Range("J2:K2").FormulaR1C1 = "Hold Time"
    Range("J3").FormulaR1C1 = "% of Occupied"
    Range("K3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("L2:M2").Merge
    Range("L2:M2").FormulaR1C1 = "Conf Trans Time"
    Range("L3").FormulaR1C1 = "% of Occupied"
    Range("M3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("N2:O2").Merge
    Range("N2:O2").FormulaR1C1 = "ACD ACW"
    Range("N3").FormulaR1C1 = "% of Occupied"
    Range("O3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("P2:Q2").Merge
    Range("P2:Q2").FormulaR1C1 = "NonACD ACW"
    Range("P3").FormulaR1C1 = "% of Occupied"
    Range("Q3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("R2:S2").Merge
    Range("R2:S2").FormulaR1C1 = "Init. AUX Time"
    Range("R3").FormulaR1C1 = "% of Occupied"
    Range("S3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("T2:U2").Merge
    Range("T2:U2").FormulaR1C1 = "Other Time"
    Range("T3").FormulaR1C1 = "% of Occupied"
    Range("U3").FormulaR1C1 = "Ave./Call (seconds)"
    Range("H1:U1").Merge
    Range("H1:U1").FormulaR1C1 = "While on the phone…What % of my time is spent in which PHONE STATE?"
    
    
    With Range("A1:AF5000")
        .Copy
      With Range("A1:AF5000")
        .PasteSpecial Paste:=xlPasteValues
        With Range("A1:AF5000")
            .Name = "Arial"
            .Font.Size = 8
        With Range("T2:U3")
            .Font.ColorIndex = 2
      End With
    End With
   End With
   End With

    With Cells
        .Columns.AutoFit
    End With

    With Range("3:3")
        .WrapText = True
    End With
    
    With Range("B3:AF5000")
        .HorizontalAlignment = xlCenter
    With Range("H1:U2")
        .HorizontalAlignment = xlCenter
    End With
  End With
  
    Rows("1:4").Font.Bold = True
    
    ''***Column Widths***''
    With Range("H:H,J:J,L:L,N:N,P:P,R:R,T:T")
  .ColumnWidth = 7.29
End With

    With Range("B:B,C:C,D:D,E:E")
  .ColumnWidth = 5
End With

    With Range("F:F,G:G")
  .ColumnWidth = 5.57
End With

    With Range("H:H")
  .ColumnWidth = 7.43
End With

    With Range("I:I,K:K,M:M,O:O,Q:Q,S:S,U:U")
  .ColumnWidth = 8
End With
    
    With Range("V:V,W:W,X:X,Y:Y,Z:Z,AA:AA,AB:AB,AC:AC,AD:AD,AE:AE,AF:AF")
  .ColumnWidth = 9
End With
    
    
    ''***Borders***''
    
With Range("A4:U" & lastrow)
   With .Borders
    .LineStyle = xlContinuous
    .Weight = xlThin
   End With
End With

   With Range("B3:U3")
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End With

    '

   With Range("H1:U1,H2:U2,A4:U4")
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End With


   With Range("H2:I" & lastrow & ",J2:K" & lastrow & ",L2:M" & lastrow & ",N2:O" & lastrow & ",P2:Q" & lastrow & ",R2:S" & lastrow & ",T2:U" & lastrow)
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End With




'***legend***'
    
    ''priority text merge''
    Range("H" & lastrow2 & ":I" & lastrow2).Merge
    Range("J" & lastrow2 & ":K" & lastrow2).Merge
    Range("L" & lastrow2 & ":M" & lastrow2).Merge
    Range("N" & lastrow2 & ":O" & lastrow2).Merge
    Range("P" & lastrow2 & ":Q" & lastrow2).Merge
    Range("R" & lastrow2 & ":S" & lastrow2).Merge
    Range("T" & lastrow2 & ":U" & lastrow2).Merge
    
    Range("H" & lastrow3 & ":I" & lastrow3).Merge
    Range("J" & lastrow3 & ":U" & lastrow3).Merge
    
    ''coaching legend text merge''
    Range("H" & lastrow5 & ":N" & lastrow5).Merge
    Range("H" & lastrow6 & ":N" & lastrow6).Merge
    Range("H" & lastrow7 & ":N" & lastrow7).Merge
    Range("H" & lastrow8 & ":N" & lastrow8).Merge
    Range("H" & lastrow10 & ":N" & lastrow10).Merge
    Range("H" & lastrow11 & ":N" & lastrow11).Merge
    
    ''priority labels''
    Cells(lastrow2, "H").Value = "Priority 7"
    Cells(lastrow2, "J").Value = "Priority 5"
    Cells(lastrow2, "L").Value = "Priority 4"
    Cells(lastrow2, "N").Value = "Priority 6"
    Cells(lastrow2, "P").Value = "Priority 2"
    Cells(lastrow2, "R").Value = "Priority 3"
    Cells(lastrow2, "T").Value = "Priority 1"
    
    Cells(lastrow3, "J").Value = "Reducing These Increases Talk Time %, Reduces Occupancy and Increases Availability"
    
    ''coaching legend labels''
    Cells(lastrow5, "H").Value = "Coaching Legend"
    Cells(lastrow6, "H").Value = "Low Talk %, Low Talk Time - Follow priorities to bring Talk% up"
    Cells(lastrow7, "H").Value = "Low Talk %, high Talk Time - Same as above"
    Cells(lastrow8, "H").Value = "Low/High Talk %, Extremely low talk Time - monitor for phone state 'games'"
    Cells(lastrow10, "H").Value = "High Talk %, High Talk Time - Coach on Talk Time"
    Cells(lastrow11, "H").Value = "High Talk %, Low Talk Time - This is what we are looking for"
    
    ''**Legend Borders**''
    
    With Range("H" & lastrow2 & ":I" & lastrow2 & ",J" & lastrow2 & ":K" & lastrow2 & ",L" & lastrow2 & ":M" & lastrow2 & ",N" & lastrow2 & ":O" & lastrow2 & ",P" & lastrow2 & ":Q" & lastrow2 & ",R" & lastrow2 & ":S" & lastrow2 & ",T" & lastrow2 & ":U" & lastrow2)
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
End With


    With Range("H" & lastrow3 & ":I" & lastrow3 & ",J" & lastrow3 & ":U" & lastrow3)
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
    End With
End With


    'actual legend border'
    
    With Range("H" & lastrow5 & ":N" & lastrow11)
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
    End With
End With


''***colors***''

 With Cells.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
    End With
    
    Range("H2:I3").Interior.ColorIndex = 4
    Range("J2:K3").Interior.ColorIndex = 6
    Range("L2:M3").Interior.ColorIndex = 38
    Range("N2:O3").Interior.ColorIndex = 40
    Range("P2:Q3").Interior.ColorIndex = 3
    Range("R2:S3").Interior.ColorIndex = 39
    Range("T2:U3").Interior.ColorIndex = 16
    Range("A4:U4").Interior.ColorIndex = 15
    
    Range("J" & lastrow3 & ":U" & lastrow3).Interior.ColorIndex = 15
    Range("J" & lastrow3 & ":U" & lastrow3).Font.Bold = True
    Range("H" & lastrow2 & ":I" & lastrow2 & ",J" & lastrow2 & ":K" & lastrow2 & ",L" & lastrow2 & ":M" & lastrow2 & ",N" & lastrow2 & ":O" & lastrow2 & ",P" & lastrow2 & ":Q" & lastrow2 & ",R" & lastrow2 & ":S" & lastrow2 & ",T" & lastrow2 & ":U" & lastrow2).Font.Bold = True
    
    With Range("H" & lastrow5 & ":N" & lastrow5)
        .Font.Bold = True
        .Font.Underline = xlUnderlineStyleSingle
    End With
    
    'raw removed'
    Columns("V:AF").Delete Shift:=xlToLeft
    
    ''legend alignment - look to clean up code later''
    Range("H" & lastrow5 & ":N" & lastrow5).HorizontalAlignment = xlLeft
    Range("H" & lastrow6 & ":N" & lastrow6).HorizontalAlignment = xlLeft
    Range("H" & lastrow7 & ":N" & lastrow7).HorizontalAlignment = xlLeft
    Range("H" & lastrow8 & ":N" & lastrow8).HorizontalAlignment = xlLeft
    Range("H" & lastrow10 & ":N" & lastrow10).HorizontalAlignment = xlLeft
    Range("H" & lastrow11 & ":N" & lastrow11).HorizontalAlignment = xlLeft
    
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    
    
End Sub
 

Excel Facts

Select all contiguous cells
Pressing Ctrl+* (asterisk) will select the "current region" - all contiguous cells in all directions.
Sort by date Sort by votes
I am guessing that your file size is getting big due to the insertion of the formulae in the section that is as listed below:
Range("H4:H5000").FormulaR1C1 = "=IF(RC[17]="""","""",RC[17]/RC[24])"
Range("I4:I5000").FormulaR1C1 = "=IF(RC[16]="""","""",RC[16]/RC[-7])"
Range("J4:J5000").FormulaR1C1 = "=IF(RC[16]="""","""",RC[16]/RC[22])"
Range("K4:K5000").FormulaR1C1 = "=IF(RC[15]="""","""",RC[15]/RC[-9])"
Range("L4:L5000").FormulaR1C1 = "=IF(RC[15]="""","""",RC[15]/RC[20])"
Range("M4:M5000").FormulaR1C1 = "=IF(RC[14]="""","""",RC[14]/RC[-11])"
Range("N4:N5000").FormulaR1C1 = "=IF(RC[14]="""","""",RC[14]/RC[18])"
Range("O4:O5000").FormulaR1C1 = "=IF(RC[13]="""","""",RC[13]/RC[-13])"
Range("P4:P5000").FormulaR1C1 = "=IF(RC[13]="""","""",RC[13]/RC[16])"
Range("Q4:Q5000").FormulaR1C1 = "=IF(RC[12]="""","""",RC[12]/RC[-15])"
Range("R4:R5000").FormulaR1C1 = "=IF(RC[12]="""","""",RC[12]/RC[14])"
Range("S4:S5000").FormulaR1C1 = "=IF(RC[11]="""","""",RC[11]/RC[-17])"
Range("T4:T5000").FormulaR1C1 = "=IF(RC[11]="""","""",RC[11]/RC[12])"
Range("U4:U5000").FormulaR1C1 = "=IF(RC[10]="""","""",RC[10]/RC[-19])"

I may have missed something, but it doesn't appear that there is a delete statement if the values are empty or zero. If I am right, you should be able to go to one of the cells in these columns and see the formula in the edit bar, even thought there is no value displayed. - i.e. go to R100 and see if there is a formula there.

I typed in just your formula for column H with no values anywhere else, and copied it from H4 to H5000. This resulted in the file size going from 14K to over 300K.

Hope this helps.
 
Upvote 0
it did help, thank you. i was able to reduce it by quite a bit. i should probably look to make it so the range is not hard coded as well.
 
Upvote 0
You must log in or register to reply here.

Similar threads

zookeepertx
  • Question Question
Having trouble "deciphering" some code so I can see how it works
Replies
7
Views
376
zookeepertx
zookeepertx
H
  • Question Question
Save and Close Excel after a 15min inactivity.
Replies
4
Views
773
Hopey87
H
B
  • Solved
VBA to check if worksheet exists
Replies
8
Views
321
bdt
B
G
  • Solved
VBA CODE NOT WORKING WITH OTHER WORKBOOK
Replies
5
Views
558
Alex Blakenburg
A
A
  • Solved
every time I run this code the auto filter only filters 1 column any ideals
Replies
1
Views
688
HaHoBe
HaHoBe

Forum statistics

Threads
1,224,226
Messages
6,177,275
Members
452,765
Latest member
Erka Gizli

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top