Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
Below is the code I use to delete rows from a spreadsheet based on multiple
criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
Don't select and then delete. Instead of:
range(.....).Select Selection.Delete.......... use range(.....).Delete -- Gary''s Student - gsnu200908 "QuietMan" wrote: Below is the code I use to delete rows from a spreadsheet based on multiple criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
Hi,
In addition turn off calculation Application.Calculation = xlCalculationManual code Application.Calculation = xlCalculationAutomatic Mike "QuietMan" wrote: Below is the code I use to delete rows from a spreadsheet based on multiple criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
I'm not sure how fast the following code will be, but I'm thinking it should
be speedier than your posted code. One note though... the code assumes that either there are no blank cells in Column A within the list of User ID numbers or, if there are, that those rows should be deleted (as long as columns 2 through 16 are blank as well). I also note that what you list as two separate criteria (Column 16 is blank and Columns 2 to 15 are blank) is really just a single condition (Columns 2 to 16 are blank). Give the macro a try (on a **copy** of your data) and see how it works for you... Sub DeleteEmptyData() Dim X As Long, LastRow As Long, R As Range, Blanks As Range LastRow = Cells(Rows.Count, "A").End(xlUp).Row Set Blanks = Range("B1:B" & LastRow).SpecialCells( _ xlCellTypeBlanks).EntireRow For X = 2 To 16 Set R = Columns(X).SpecialCells(xlCellTypeBlanks) Set Blanks = Intersect(R, Blanks).EntireRow Next Blanks.Delete End Sub -- Rick (MVP - Excel) "QuietMan" wrote in message ... Below is the code I use to delete rows from a spreadsheet based on multiple criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
I think this is what you're looking for. Test is on a COPY of your
workbook, just in case. Option Explicit Sub C_Remove_Blank_Rows() Dim myRange As Excel.Range Dim aWS As Excel.Worksheet Dim lRow As Long Dim i As Long Dim myCount As Long Dim myDeleteRange As Excel.Range Dim r As Excel.Range Dim myCell As Excel.Range 'Below is the code I use to delete rows from a spreadsheet based on multiple 'criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains 'user ID) Set aWS = ActiveSheet lRow = aWS.Cells(aWS.Rows.Count, 1).End(xlUp).Row Set myRange = aWS.Cells(1, 1).Resize(lRow, 1) For Each r In myRange myCount = 0 If IsEmpty(r) Then myCount = myCount + 1 End If For i = 1 To 15 Set myCell = r.Offset(0, 1) If IsEmpty(myCell) Then myCount = myCount + 1 End If Next i If myCount = 16 Then If myDeleteRange Is Nothing Then Set myDeleteRange = r.EntireRow Else Set myDeleteRange = Union(myDeleteRange, r.EntireRow) End If End If Next r If Not myDeleteRange Is Nothing Then myDeleteRange.Delete End If End Sub HTH Barb Reinhardt "QuietMan" wrote: Below is the code I use to delete rows from a spreadsheet based on multiple criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
Just realized that I didn't iterate on myCell. Replace the set MyCell line
with this Set myCell = r.Offset(0, i) "QuietMan" wrote: Below is the code I use to delete rows from a spreadsheet based on multiple criteria. (column 16 is empty, column 2 to 15 is empty, column 1 contains user ID) The macro work great, but the spreadsheet is about 150K rows and it takes 15 to 20 minutes to run. I was hoping that someone would know how to make the macro faster. I cannot sort the data and the order is very important in the next steps... I now delete the blank rows in column 16 one at a time, and they are some times clustered 30 rows together...was thinking if I could modify the code to delete blocks of rows ratther that one at a time it might speeed up the execution Thanks Sub C_Remove_Blank_Rows() Application.ScreenUpdating = False Cells(200000, 14).Select Selection.End(xlUp).Select EndRow = ActiveCell.Row Do Until EndRow < 2 If Cells(EndRow, 16) < Empty Then GoTo No_Find Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find2 No_Find: Set r = Range(Cells(EndRow, 1), Cells(EndRow, 15)) r.Select For Each r In Selection If IsEmpty(r) Then Else GoTo No_Find2 Exit Sub End If Next Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp GoTo No_Find3 No_Find2: If Left(Cells(EndRow, 1), 9) < " USER ID" Then GoTo No_Find3 Rows(EndRow & ":" & EndRow).Select: Selection.Delete Shift:=xlUp No_Find3: EndRow = EndRow - 1 Loop Application.ScreenUpdating = True End Sub -- Helping Is always a good thing |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Speeding up a delete rows Macro
I don't know which posting to respond to. The quickest method of deleteing rows is to add a formula into an auxillary column putt an X in the column for row to delete. You can add the formula into row IV like this Sub Macro1() Range("IV1").Formula = "=if(A1 5,X,Y)" 'then copy the formula down the entire LastRow = Range("A" & Rows.Count).End(xlUp) Range("IV1").Copy _ Destination:=Range("IV1:IV" & LastRow) 'Next replace formula in column IV with value Range("IV1:IV" & LastRow).Copy Range("IV1:IV" & LastRow).PasteSpecial Paste:=xlPasteValues 'Next sort on Row IV Rows("1:" & LastRow).Sort _ header:=xlYes, _ key1:=Range("IV1"), _ Order:=xlAscending 'Now all you have to do is delete the X's. 'asume these is a header row Columns("IV").AutoFilter Columns("IV").AutoFilter Field:=1, Criteria1:="X" Rows("2:" & LastRow).SpecialCells(Type:=xlCellTypeVisible).Del ete Columns("IV").Delete End Sub this may seem like a lot of steps, but it is the quickest method -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=150619 Microsoft Office Help |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Speeding up Hide rows code | Excel Programming | |||
Speeding up execution of a Macro | Excel Programming | |||
Speeding up Macro | Excel Programming | |||
Speeding Up Macro in VBA | Excel Programming | |||
speeding up a macro | Excel Programming |