Hi Jim.........
It's unbelievable how much improvement your changes make!!!.......just
amazing. Thank you so much, kind Sir.
Vaya con Dios,
Chuck, CABGx3
"Jim Thomlinson" <James_Thomlinson@owfg-Re-Move-This-.com> wrote in message
news:892DC78F-00B1-4009-A19C-(E-Mail Removed)...
> Every time you clear contents XL will have to recalculate. That will slow
> things down substantially. There are 2 ways to deal with that. One is to
make
> one big range to be cleared all at once. The other is to temporarily
suspend
> calculation. Since you are only clearing contents and not deleting I might
be
> more inclined to just suspend calculations. Additionally if you suspend
> screen updaing that should speed things up...
>
> One note is to change xlGuess to xlYes or xlNo in yoru sort depending on
> whether you have a header row or not. xlGuess leaves xl to guess what you
> want.
>
> Sub DeleteTheOldestMonth()
> Dim lastrow As Long, r As Long
> Dim oldest As String
>
> With Application
> .ScreenUpdating = False
> .Calculation = xlCalculationManual
> End With
>
> Range("data!k1").Value = "=min(ALL12!Q13:Q10000)" 'col Q contains dates
> 'using the first day of each month only
>
> oldest = Range("data!k1").Value
> With Sheets("ALL12")
> lastrow = .Cells(.Rows.Count, "a").End(xlUp).Row
> For r = lastrow To 13 Step -1
>
> If .Cells(r, "Q").Value Like oldest Then
> .Rows(r).EntireRow.ClearContents
> End If
> Next r
> End With
> 'Sort the database, firstkey col A, secondkey col Q to eliminate blank
rows
> 'without changing the RANGE of the database, A12:S10000
> .Range("A12:z10000").Sort Key1:=Range("A12"), Order1:=xlAscending, _
> Key2:=Range("Q12"), Order2:=xlAscending, _
> Header:=xlGuess, _
> OrderCustom:=1, MatchCase:=False, _
> Orientation:=xlTopToBottom
>
> 'Range("A12").Select
> With Application
> .ScreenUpdating = False
> .Calculation = xlCalculationAutomatic
> End With
>
> End Sub
> --
> HTH...
>
> Jim Thomlinson
>
>
> "CLR" wrote:
>
> > Hi All.......
> > Below is code that works fine, it just takes a long time to run and I
was
> > hoping someone could give me an idea how to speed it up.....like by
cutting
> > the time in half or better......the idea behind it is that on a 3500 row
> > database, each row has a date in column Q that is the first day of the
month
> > only. This macro effectively deletes all rows whose date equals the
oldest
> > date in column Q. Incidently, if I use "delete" instead of
"clearcontents
> > and then sort", it causes a reduction of the size of the database each
time
> > it's run, which is unacceptable.
> >
> > Here's the code:
> > Sub DeleteTheOldestMonth()
> > Dim lastrow As Long, r As Long
> > Dim oldest As String
> > Range("data!k1").Value = "=min(ALL12!Q13:Q10000)" 'col Q contains dates
> > 'using the first day of each month only
> > oldest = Range("data!k1").Value
> > Sheets("ALL12").Select
> > lastrow = Cells(Rows.Count, "a").End(xlUp).Row
> > For r = lastrow To 13 Step -1
> >
> > If Cells(r, "Q").Value Like oldest Then
> > Rows(r).EntireRow.ClearContents
> > End If
> > Next r
> >
> > 'Sort the database, firstkey col A, secondkey col Q to eliminate blank
rows
> > 'without changing the RANGE of the database, A12:S10000
> > Range("A12:z10000").Select
> > Selection.Sort Key1:=Range("A12"), Order1:=xlAscending,
> > Key2:=Range("Q12" _
> > ), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:=
> > _
> > False, Orientation:=xlTopToBottom
> >
> > Range("A12").Select
> > End Sub
> >
> > TIA
> > Vaya con Dios,
> > Chuck, CABGx3
> >
> >
> >
> >
> >
|
Similar Threads
