A macro emergency!

G

Guest

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
 
D

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top