with all those deletes you should use
Application.Calculation = xlCalculationManual
at the begining

and
Application.Calculation = xlCalculationAutomatic

(or at least until all the deletes are done).

to speed things up you could also use
application.screenupdating = false

and

application.screenupdating = true
at the end.

On top of things, you don't need this
> Columns("D:F").Select
> Selection.Delete Shift:=xlToLeft

just use columns("D:F").delete

(this goes the same for most of the other things you do where you first
select the columns and then do something to them. just use
columns("...").whatever)

these are some simple things you could use to speed up your code.

Cheers,

Scott


"Sharkbait" wrote:

> Here's the code btw.
>
> Cells.Select
> Application.CutCopyMode = False
> With Selection
> .WrapText = False
> .Orientation = 0
> .AddIndent = False
> .ShrinkToFit = False
> .MergeCells = False
> End With
> Columns("C:E").Select
> Selection.Delete Shift:=xlToLeft
> Columns("D:F").Select
> Selection.Delete Shift:=xlToLeft
> Columns("E:F").Select
> Selection.Delete Shift:=xlToLeft
> Columns("F:G").Select
> Selection.Delete Shift:=xlToLeft
> Columns("G:H").Select
> Selection.Delete Shift:=xlToLeft
> Range("I1").Select
> Selection.Cut Destination:=Range("J1")
> Columns("H:I").Select
> Selection.Delete Shift:=xlToLeft
> Columns("I:I").Select
> Selection.Delete Shift:=xlToLeft
> Range("I5:AA5").Select
> Selection.Copy
> Range("I1").Select
> ActiveSheet.Paste
> Columns("J:J").Select
> Application.CutCopyMode = False
> Selection.Delete Shift:=xlToLeft
> Columns("K:M").Select
> Selection.Delete Shift:=xlToLeft
> Columns("L:L").Select
> Selection.Delete Shift:=xlToLeft
> Columns("M:N").Select
> Selection.Delete Shift:=xlToLeft
> Columns("N:N").Select
> Selection.Delete Shift:=xlToLeft
> Columns("P:P").Select
> Selection.Delete Shift:=xlToLeft
> ActiveWindow.SmallScroll ToRight:=3
> ActiveWindow.ScrollColumn = 1
> Columns("A:A").Select
> ActiveCell.Replace What:="WANT DATE:", Replacement:="", LookAt:=xlPart,
> _
> SearchOrder:=xlByRows, MatchCase:=False
> Columns("A:A").Select
> Selection.Replace What:="Want Date:", Replacement:="", LookAt:=xlPart,
> _
> SearchOrder:=xlByRows, MatchCase:=False
>
> Columns("B:B").Select
> Selection.Insert Shift:=xlToRight
> Range("A1:A614").Select
> Selection.Copy
> Range("B2").Select
> ActiveSheet.Paste
> Range("A600").Select
> ActiveCell.FormulaR1C1 = "ZZZ"
> Range("C600").Select
> ActiveCell.FormulaR1C1 = "ZZZ"
> Range("A3").Select
> Do Until ActiveCell = "ZZZ"
> If CellColorIndex(ActiveCell, False) = 15 Then
> ActiveCell.Offset(1, 0).Select
> Else: ActiveCell.Offset(-1, 0).Select
> Range(Selection, Selection.Offset(1, 0)).Select
> Selection.FillDown
> End If
> Loop
> Range("C6").Select
> Do Until ActiveCell = "ZZZ"
> If IsEmpty(ActiveCell) = True Then
> ActiveCell.Offset(1, 0).Select
> Else: ActiveCell.Offset(0, -1).Select
> If IsEmpty(ActiveCell) = True Then
> ActiveCell.Offset(-1, 0).Select
> Range(Selection, Selection.Offset(1, 0)).Select
> Selection.FillDown
> ActiveCell.Offset(2, 1).Select
> Else: ActiveCell.Offset(1, 1).Select
> End If
> End If
> Loop
> Range("A2", "S600").Select
> Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess,
> _
> OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
> Range("A2").Select
> Columns("E:I").EntireColumn.AutoFit
> Columns("H:H").Select
> Selection.NumberFormat = "#,##0"
> Columns("J:S").Select
> Selection.NumberFormat = "0.0"
> Columns("J:S").Select
> Selection.ColumnWidth = 5.5
> Range("A1:S1").Select
> With Selection
> .WrapText = True
> .Orientation = 0
> .AddIndent = False
> .ShrinkToFit = False
> .MergeCells = False
> End With
> Sharkbait wrote:
> > Thanks.
> >
> > One other quick question though.
> >
> > I have a macro that runs very fast in one workbook. I also need to use
> > it in another workbook. So, I inserted a new module and pasted the
> > macro into the other workbook. For some reason, it runs very slow in
> > the new workbook.
> >
> > The first workbook only has that one macro, while the other has 5. Not
> > sure if that matters. Also the first workbook is about 590kb while the
> > other is about 2.3mb. Again, not sure if that matters.
> >
> > Any help would be appreciated.
> >
> > Dave Peterson wrote:
> > > Isempty() will work with one cell--not multiple cells, but maybe you could use:
> > >
> > > if application.counta(yourrangehere) = 0 then
> > > 'all the cells are empty
> > >
> > >
> > > Sharkbait wrote:
> > > >
> > > > As I progress in VBA, I'm trying to make my macros more elegant and
> > > > less heavy-handed. One of those problems is how I end Do loops with
> > > > embedded If loops. I was previously just inserting a stop point in the
> > > > column. Something like 'Do Until ActiveCell = "End"'.
> > > > That works ok, until the range I'm working on is much shorter than my
> > > > stop range.
> > > >
> > > > Is it possible to use IsEmpty to test a 15 cell block, and if they're
> > > > all empty to end, or insert my end point?
> > > >
> > > > I've tried using the following code, but it doesn't work.
> > > >
> > > > Range("C1").Select
> > > > Do Until ActiveCell = "ZZZ"
> > > > Range(ActiveCell, ActiveCell.Offset(15, 0)).Select
> > > > If IsEmpty(Selection) = True Then
> > > > ActiveCell.Offset(10, 0).Select
> > > > ActiveCell.FormulaR1C1 = "ZZZ"
> > > > Else: ActiveCell.Offset(5, 0).Select
> > > > End If
> > > > Loop
> > > >
> > > > Thanks
> > >
> > > --
> > >
> > > Dave Peterson
>
>