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

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

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

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

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
>
>

Another thing to do is to stop selecting ranges before you work with them.

And instead of doing them little bits at a time, you could get rid of whole
columns like:

Range("C1:e1,g1:i1,k1:m1,n11,q1:r1,t1:u1,w1").EntireColumn.Delete



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

--

Dave Peterson