Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can this code be speeded up?
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can this code be speeded up?
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Can this code be speeded up?
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" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. | Excel Programming | |||
Protect Sheet with code, but then code will not Paste error. How do i get around this. Please read for explainations.... | Excel Programming | |||
Excel code convert to Access code - Concat & eliminate duplicates | Excel Programming | |||
Can the "Save" process be speeded up? | Excel Programming |