Hi All,
Looking for some quick running code to remove rows containing a zero value in column Z.
Row 1 contains column headings and Row 2 downwards contains the data.
Hi All,
Looking for some quick running code to remove rows containing a zero value in column Z.
Row 1 contains column headings and Row 2 downwards contains the data.
Sub delteme() With ActiveSheet.Range("Z2", Range("Z" & Rows.Count).End(xlUp)) .replace "0", "" .SpecialCells(4).EntireRow.Delete End With End Sub
The code does not find empty cells. You can trap the error, but the code might not delete the rows.
Sub delteme() With ActiveSheet.Range("Z2", Range("Z" & Rows.Count).End(xlUp)) .Replace "0", "" On Error Resume Next .SpecialCells(4).EntireRow.Delete End With End Sub
Sub DeleteZeroRows() Dim lRow As Long For lRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1 If Cells(lRow, 26).Value = 0 Then Rows(lRow).EntireRow.Delete Next lRow End Sub
let Source = #table({"Question","Thread", "User"},{{"Answered","Mark Solved", "Add Reputation"}}) in Source
If I give you Power Query (Get & Transform Data) code, and you don't know what to do with it, then CLICK HERE
Walking the tightrope between genius and eejit...
Sub deleteme() Dim LR As Long With ActiveSheet .Rows(1).AutoFilter .Rows(1).AutoFilter 26, "0" LR = .Range("Z" & .Rows.Count).End(xlUp).Row If LR > 2 Then .Range("Z2:Z" & LR).EntireRow.Delete End If .Rows(1).AutoFilter End With End Sub
Yes, because you have got empty string, but not empty cells. Did you try the filter?
Last try
Sub delteme() With ActiveSheet.Range("Z2", Range("Z" & Rows.Count).End(xlUp)) .Replace "", "" On Error Resume Next .SpecialCells(4).EntireRow.Delete End With End Sub
You could try this, might be a bit quicker:
Sub macro_1() Dim rng, count Set rng = ActiveSheet.Range("Z" & Rows.count) For count = ActiveSheet.UsedRange.Rows.count To 2 Step -1 If Cells(count, 26).Value = 0 Then Set rng = Union(rng, Cells(count, 26)) Next rng.EntireRow.Delete End Sub
AB33 both sets of code run through to the end but don't do anything?
Yudlugar seems to be a bit quicker and works 100% but stills takes > 5 minutes. Wondering how i can speed this up somehow.
Last edited by Gti182; 11-12-2013 at 06:50 AM.
How long does your sheet take to recalculate? I tested it on 7000+ rows and it was a few seconds.
what value do you get for ActiveSheet.UsedRange.Rows.count?
5890 rows at the moment, takes +- 2 seconds to fully recalculate the workbook
How long does it take just for this:
?Sub macro_1() Dim rng, count Set rng = ActiveSheet.Range("Z" & Rows.count) For count = 5000 To 2 Step -1 If Cells(count, 26).Value = 0 Then Set rng = Union(rng, Cells(count, 26)) Next End Sub
4-5 seconds
So it must be this line:
that is taking time.rng.EntireRow.Delete
I don't see what would be quicker than selecting all the rows and deleting them in one go, apart from turning off calculation as you mention I don't think you can speed it up much more. What is the code you are using to turn the calculation off?
I just tried filtering and selecting zero value rows only then manually deleting with manual calculation on and that takes +- 3 min.
I added this extra to your code.
Sub deleteROWS() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.DisplayAlerts = False Application.AskToUpdateLinks = False ' ENTER MACRO CODE HERE Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.AskToUpdateLinks = True MsgBox "Compare Complete" End Sub
Just thinking out loud but is this any quicker:
Sub DeleteZeroRows() application.screenupdating = false application.calculation = xlmanual dim ws1, ws2, count Dim lRow As Long set ws1 = activesheet set ws2 = sheets.add count = 2 For lRow = ws1.UsedRange.Rows.Count To 2 Step -1 If not ws1.Cells(lRow, 26).Value = 0 Then ws2.Rows(count).cells.formula = ws1.rows(lrow).cells.formula count = count + 1 end if Next lRow application.screenupdating = true application.calculation = xlmanual End Sub
Try,
Sub moveMatches() Application.ScreenUpdating = 0 Dim myrng As Range, LR As Long, i As Long With ActiveSheet LR = .Cells(.Rows.Count, "Z").End(xlUp).Row For i = 2 To LR If .Cells(i, "Z") = 0 Or .Cells(i, "Z") = vbNullString Then If myrng Is Nothing Then Set myrng = .Cells(i, "Z") Else Set myrng = Union(myrng, .Cells(i, "Z")) End If End If Next i End With If Not myrng Is Nothing Then myrng.EntireRow.Delete End If Application.ScreenUpdating = True End Sub
Last edited by AB33; 11-12-2013 at 03:03 PM.
thanks for all the help peeps! AB33 that code works well
AB33's code #19 looks identical to the code in post #10 to me. Are you ssaying the code in #19 is faster than that in #10?
If so, anyone got any pointers as to why?
Did you try the code in post #18 to see if it ran quicker?
code in #19 isn't much faster if at all.
code #18 created another tab with unformatted data but didn't remove any rows from original data tab
Code#18 wasn't set up to solve the problem. I was wondering if it was faster to run. If so, it might be quicker to copy the rows you want into a new sheet, delete the original and rename the new sheet. Seeing as it was deleting the rows that seemed to be the problem.
Ah ok, the code I gave you will have copied the formulas but not formats you could try:
But that might take longer. How consistent are the formats? What do they look like, it shouldn't be too difficult to reapply them...Sub DeleteZeroRows() application.screenupdating = false application.calculation = xlmanual dim ws1, ws2, count, ws_name Dim lRow As Long set ws1 = activesheet set ws2 = sheets.add count = 2 For lRow = ws1.UsedRange.Rows.Count To 2 Step -1 If not ws1.Cells(lRow, 26).Value = 0 Then ws1.rows(lrow).copy ws2.Range("A" & count) end if Next lRow ws_name = ws1.name ws1.delete ws2.name = ws_name application.screenupdating = true application.calculation = xlmanual End Sub
hmm formatting is a mixed bag of dates, values, text, etc. not too hard to replicate.
The quickest way to do it manually is sorting the value column by smallest to largest or largest to smallest and then manually deleting all the zero value rows. Might be tricky to automate this to find the range of all the zero value rows though
Is it consistent in each column?
Any chance you can upload a workbook? Just a few rows to demonstrate what the formatting looks like, the data itself can be replaced with non-sensitive info if neccessary.
What you mention as the quickest way manually is what the code in #10 and #19 does. I think it might be quicker this way though.
test file attached with formatting
Test.xlsx
please note there are about 30 other tabs which feed off this single tab which have been removed
Try. This is faster
takes pretty much the same time as the others.
I think the thing that's causing the processing time to be so long is the actual deleting of the filtered zero rows. If they were sorted rather than filtered and then zero rows deleted it would be immediate
Last edited by Gti182; 11-13-2013 at 09:41 AM.
double post oops
It is inconceivable a loop and filter could take the same amount of time. Yes, sorting can make a difference, but without it ,filter is still much faster than any loop.
I think the issue may be with the type of data you have rather codes. Are these data imported from a site, or Accounting applications, such as SAP? If so, then you need to clean these data first.
the data is an export from oracle into an excel file. I then cut and paste this data to a model and copy format/formula's down from rows above.
Ohm! I knew that.
Data imported from Oracle have lots of unseen characters. Yes, copying and pasting VALUES ONLY will get rid most of these dirty data, but not all. What you need is to trim and clean data as well. You should not also put the imported data with the clean data. Clean the data first, then delete that sheet and save the new one on its own. I have almost lost my laptop on 3 occasions because of this issue.
I have amended the code with sort code.
BOOM! AB33 took +- 1 second to run and works perfectly thanks for all the help really appreciate it!
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks