A macro emergency!

[cinvic]

I earned lots of praise for the macros I developed with the help of my online
friends. Thank you all for your help!!!

I have files with macros that are huge: 31.8 MB!! How can I condense,
compress, or eliminate the macros (which are no longer needed) to be able to
open, close, and email the files easily? I tried the neat trick of deleting
all my temporary files, compressing the individual file but nothing helped. I
have added the macros that I used to create my beautiful files for your
viewing pleasure:
Sub Copy()
'
' Copy Macro
' Macro recorded 2/3/2006 by 709903
'
' Keyboard Shortcut: Ctrl+y
' Name sheet to be sliced and diced
Sheets("ToBeCut").Select
Sheets("ToBeCut").Copy
Sheets.Add
Sheets("ToBeCut").Select
Cells.Select
Selection.Copy
Sheets("Sheet1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Range("A6:Z6").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
'The range can be changed to accomodate needs
Selection.Sort Key1:=Range("D7"), Order1:=xlAscending,
Key2:=Range("G7") _
, Order2:=xlAscending, Key3:=Range("A7"), Order3:=xlAscending,
Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
ActiveWindow.SmallScroll Down:=174
Selection.Sort Key1:=Range("D7"), Order1:=xlAscending, Key2:=Range("G7") _
, Order2:=xlAscending, Key3:=Range("H7"), Order3:=xlAscending,
Header:= _
xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal

Dim wb As Workbook
Dim ws As Worksheet
Dim varVal1 As Variant
Dim varVal2 As Variant

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
ws.Activate
' The range upon when to add a line is based
Range("G7").Select

varVal1 = ActiveCell.Value
varVal2 = ActiveCell.Offset(1).Value

Do Until varVal1 = ""
If varVal1 <> varVal2 Then
ActiveCell.Offset(1).Select
Selection.EntireRow.Insert
End If
ActiveCell.Offset(1).Select
varVal1 = ActiveCell.Value
varVal2 = ActiveCell.Offset(1).Value
Loop

Set wb = Nothing
Set ws = Nothing

End Sub


Sub InsertCategoryLines()

Dim wb As Workbook
Dim ws As Worksheet
Dim varVal1 As Variant
Dim varVal2 As Variant

Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Sheet1")
ws.Activate
ActiveCell.Select

varVal1 = ActiveCell.Value
varVal2 = ActiveCell.Offset(1).Value

Do Until varVal1 = ""
If varVal1 <> varVal2 Then
ActiveCell.Offset(1).Select
' The 5 represents how many rows to insert
Selection.Resize(5, 1).EntireRow.Insert
End If
ActiveCell.Offset(1).Select
varVal1 = ActiveCell.Value
varVal2 = ActiveCell.Offset(1).Value
Loop

Set wb = Nothing
Set ws = Nothing

End Sub
Sub Formula()
'
' Formula Macro
' Macro recorded 2/3/2006 by 709903
'
' Keyboard Shortcut: Ctrl+f
'
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=SUMIF(C2,RC7,C)"
ActiveCell.Font.Bold = True

End Sub

Suggestions are most welcome.
cinvic

[Don Guillett]

First. Please do NOT declare an emergency. All here are treated the same and
it is a "turn off" where many will not bother to even look. Try this from
Pascal. You not only have to delete the macros but you must also remove the
modules.

Sub DeleteAllMacros()
Dim Composantvbe As Object
With ActiveWorkbook.VBProject
For Each Composantvbe In .VBComponents
If Composantvbe.Type = 100 Then
With Composantvbe.CodeModule
.DeleteLines 1, .CountOfLines
.CodePane.Window.Close
End With
Else: .VBComponents.Remove Composantvbe
End If
Next Composantvbe
End With
End Sub


HTH
Cordially



--
Don Guillett
SalesAid Software
dguillett1@austin.rr.com
"cinvic" <cinvic@discussions.microsoft.com> wrote in message
news:AF79A680-CCB3-4DEF-84FD-573A02057928@microsoft.com...
>I earned lots of praise for the macros I developed with the help of my
>online
> friends. Thank you all for your help!!!
>
> I have files with macros that are huge: 31.8 MB!! How can I condense,
> compress, or eliminate the macros (which are no longer needed) to be able
> to
> open, close, and email the files easily? I tried the neat trick of
> deleting
> all my temporary files, compressing the individual file but nothing
> helped. I
> have added the macros that I used to create my beautiful files for your
> viewing pleasure:
> Sub Copy()
> '
> ' Copy Macro
> ' Macro recorded 2/3/2006 by 709903
> '
> ' Keyboard Shortcut: Ctrl+y
> ' Name sheet to be sliced and diced
> Sheets("ToBeCut").Select
> Sheets("ToBeCut").Copy
> Sheets.Add
> Sheets("ToBeCut").Select
> Cells.Select
> Selection.Copy
> Sheets("Sheet1").Select
> Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
> SkipBlanks _
> :=False, Transpose:=False
> Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
> SkipBlanks:=False, Transpose:=False
> Range("A6:Z6").Select
> Range(Selection, Selection.End(xlDown)).Select
> Application.CutCopyMode = False
> 'The range can be changed to accomodate needs
> Selection.Sort Key1:=Range("D7"), Order1:=xlAscending,
> Key2:=Range("G7") _
> , Order2:=xlAscending, Key3:=Range("A7"), Order3:=xlAscending,
> Header:= _
> xlYes, OrderCustom:=1, MatchCase:=False,
> Orientation:=xlTopToBottom, _
> DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=
> _
> xlSortNormal
> ActiveWindow.SmallScroll Down:=174
> Selection.Sort Key1:=Range("D7"), Order1:=xlAscending,
> Key2:=Range("G7") _
> , Order2:=xlAscending, Key3:=Range("H7"), Order3:=xlAscending,
> Header:= _
> xlYes, OrderCustom:=1, MatchCase:=False,
> Orientation:=xlTopToBottom, _
> DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=
> _
> xlSortNormal
>
> Dim wb As Workbook
> Dim ws As Worksheet
> Dim varVal1 As Variant
> Dim varVal2 As Variant
>
> Set wb = ActiveWorkbook
> Set ws = wb.Worksheets("Sheet1")
> ws.Activate
> ' The range upon when to add a line is based
> Range("G7").Select
>
> varVal1 = ActiveCell.Value
> varVal2 = ActiveCell.Offset(1).Value
>
> Do Until varVal1 = ""
> If varVal1 <> varVal2 Then
> ActiveCell.Offset(1).Select
> Selection.EntireRow.Insert
> End If
> ActiveCell.Offset(1).Select
> varVal1 = ActiveCell.Value
> varVal2 = ActiveCell.Offset(1).Value
> Loop
>
> Set wb = Nothing
> Set ws = Nothing
>
> End Sub
>
>
> Sub InsertCategoryLines()
>
> Dim wb As Workbook
> Dim ws As Worksheet
> Dim varVal1 As Variant
> Dim varVal2 As Variant
>
> Set wb = ActiveWorkbook
> Set ws = wb.Worksheets("Sheet1")
> ws.Activate
> ActiveCell.Select
>
> varVal1 = ActiveCell.Value
> varVal2 = ActiveCell.Offset(1).Value
>
> Do Until varVal1 = ""
> If varVal1 <> varVal2 Then
> ActiveCell.Offset(1).Select
> ' The 5 represents how many rows to insert
> Selection.Resize(5, 1).EntireRow.Insert
> End If
> ActiveCell.Offset(1).Select
> varVal1 = ActiveCell.Value
> varVal2 = ActiveCell.Offset(1).Value
> Loop
>
> Set wb = Nothing
> Set ws = Nothing
>
> End Sub
> Sub Formula()
> '
> ' Formula Macro
> ' Macro recorded 2/3/2006 by 709903
> '
> ' Keyboard Shortcut: Ctrl+f
> '
> Application.CutCopyMode = False
> ActiveCell.FormulaR1C1 = "=SUMIF(C2,RC7,C)"
> ActiveCell.Font.Bold = True
>
> End Sub
>
> Suggestions are most welcome.
> cinvic
>