I have a spreadsheet with 200,000+ rows. I need to go through it and if in a certain column, a cell is blank, then delete that row.
I was wondering if there's any quicker way or any ideas as to how to speed this up.
Here's what I have for the loop where it deletes rows:
For i = Cells(Rows.Count, LastRowCounter).End(xlUp).row To headerQ Step -1
If IsEmpty(Cells(i, Column2DeleteRowsFrom).Value) Then Cells(i,Column2DeleteRowsFrom).EntireRow.Delete
Next i
Note: "lastRowCounter" is the column I chose (i.e. "A","B", etc.) "HeaderQ" is either 1 or 2, depending if I have headers.
AFAIK the main other way would be to use, instead of the for loop I have, to do something like (pseudo code)
For each cel in Range([the range])
If isempty(cel) then delete
next cel
But don't know that that'd be any faster.
Thanks for any ideas/tips!
(NOTE: I have turned off screen refreshing, and also have no calculations in the sheet, it's simply data).
Use the SpecialCells method to select all relevant cells at once and delete the entire row of each:
Sub delemtpy()
Dim testcol As Range
Dim lastRow As Long
Dim headerQ As Long
Dim Column2DeleteRowsFrom As Long
Dim LastRowCounter As Long
lastRow = Cells(Rows.Count, LastRowCounter).End(xlUp).Row
Set testcol = Range(Cells(headerQ, Column2DeleteRowsFrom), Cells(lastRow, Column2DeleteRowsFrom))
On Error Resume Next ' if no empty cells present
testcol.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
End Sub
This will handle the corner case where the search column contains no empty cells at all. Note the use of LastRowCounter to determine the used range.
Or use SpecialCells if you're using Excel 2010 or later...
Range(Cells(headerQ, Column2DeleteRowsFrom), Cells(Rows.Count, Cells(Rows.Count, LastRowCounter).End(xlUp).Row)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Related
Im working in a code in excel vba, to delete the rows if length value of a cell is not equal to 10
Im trying to avoid using filters bcause im using a file that contains like 1 millions of rows, and when using filters, the excel crash it.
this is what I need
For exemple
The Column A contain an ID numbers,
but if the length cell with the ID is not 10 characters
I want to delete the row, this row I doesn't need it
I searched around the forums and gathered some codes to create the following code
Sub DeleteRows()
Dim c As Range
Dim LR As Integer
Dim i As Integer
Dim sht As Worksheet
Set sht = Worksheets(2)
LR = sht.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To LR
For Each c In sht.Range("A2:A" & LR).Cells
If Len(c.Value) <> 10 Then
c.EntireRow.Delete
End If '<---------here is the error
Next
Next
Range("A1").Select
End Sub
when the macro is running it get stuck, I have to press ESC to stop the macro and the error appears in the line End If
This macro delete the rows that are not meeting the condition of length when I press the ESC button
Is there a solution in this code?
or exist better metod to delete rows without using the filters?
Since you're deleting rows you should really be counting upward, since it will mess your count up. For example, i is on row 3 and then deletes row 3, now row 4 is in row 3, and i is going to continue on what used to be row 5. So instead work your way from the bottom up.
Sub DeleteRows()
Dim LR As Long
Dim i As Long
Dim sht As Worksheet
Set sht = Worksheets(2)
LR = sht.Cells(Rows.Count, "A").End(xlUp).Row
For i = LR to 2 Step -1
If Len(sht.cells(i,1).value)<>10 then
sht.Rows(i).delete
End If
Next
Range("A1").Select
End Sub
I have made a simple macro assigned to a hotkey to select the current region and then remove the header row. The problem is that the ranges we work with are often full of blank cells which prevent the selector from capturing the entire table dependant on the activecell.
I thought about maybe simply creating a loop, offsetting the ActiveCell and trying again until it hits an illegal range, but I have a bad feeling about this approach.
Sub multieditSelect()
Dim tbl As Range
If ActiveCell.Value = "" Then
MsgBox "Select a cell with something in it, you bastard"
Exit Sub
End If
Call startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
Call endNoUpdates
Selection.Copy
End Sub
Is there a way to make this more reliable?
Edit: Let me add further complication/detail to this problem...
We work with a database and editing records en masse requires exporting them into excel, and the copy/pasting them back into the web interface, so it is common for us to be working with numerous tables of different size, using a worksheet like a notepad to store and modify them.
I want to create a sub that will select the current region irrespective of where it lies on the worksheet, quite possibly this is the third or fourth table to have been pasted onto the same sheet.
This makes going by the last column or last row too inflexible. CurrentRegion is ideal were it not for it's occasional failure to detect the table... so I suppose I need to build my own version of CurrentRegion that will overcome it's shortcomings.
Edit2: I've come up with a lazy solution.
Since these tables will always have a header, I'll just have the activecell offset up till it hits something, and hopefully that will be the header if an empty column is the starting point.
I think this will still be unreliable should there be a pocket of cells surrounded by empty cells in the middle of the table.
Sub multieditSelect2()
Dim tbl As Range
On Error GoTo errmsg
startNoUpdates
Do While ActiveCell.Value = ""
ActiveCell.Offset(-1, 0).Activate
Loop
startNoUpdates
Set tbl = ActiveCell.CurrentRegion
tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, _
tbl.Columns.Count).Select
endNoUpdates
Selection.Copy
Exit Sub
errmsg:
endNoUpdates
errMsgBox = MsgBox("Couldn't find a table!", vbCritical, "Error!")
End Sub
Edit3: Here is an example of where my code calls down:
I would like it to be able to capture the table even in this scenario where a cell in the test region is the activecell... but how?
Additional to my comment, see if this helps improve your logic (see comments in code for more details):
Sub multieditSelect()
Dim ws As Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1") 'use a variable for the sheet you want to use
Dim tbl As Range
Dim lRow As Long, lCol As Long
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row 'last row at column 1
lCol = ws.Cells(1, Columns.Count).End(xlToLeft).Column 'last column at row 1
Set tbl = ws.Range(ws.Cells(2, l), ws.Cells(lRow, lCol)) 'Set the range starting at row 2, column 1, until last row, last col
Call endNoUpdates(tbl) 'pass your range as a parameter if you require this specific range in your other sub
tbl.Copy Destination:=tbl.Offset(0, 20) 'copy 20 columns to the right
'Alternative
ws.Range("W1").Resize(tbl.Rows.Count, tbl.Columns.Count).Value = tbl.Value 'copy values to specific range
End Sub
Sub endNoUpdates(tbl As Range)
'do something with this range, i.e.:
Debug.Print tbl.address
End Sub
I have an Excel workbook with 250,000 rows and 10 columns and I want to split up the data into different workbooks. My idea was to filter the list so that Excel/VBA doesn't have to go through all 250,000 rows every time my code says to look for something in the data.
However, I've run into one specific problem with Sort and also have a general question regarding hidden rows and SpecialCells(xlCellTypeVisible). First off, here's the code:
Option Explicit
Sub Filtering()
Dim wsData As Worksheet
Dim cell As Variant
Dim lRowData As Long, lColData As Long
'filter
Set wsData = ThisWorkbook.Sheets(1)
lRowData = wsData.Cells(Rows.Count, 1).End(xlUp).Row
wsData.Range("A:A").AutoFilter Field:=1, Criteria1:="Name1"
For Each cell In wsData.Range(wsData.Cells(2, 1), wsData.Cells(100, 1)).SpecialCells(xlCellTypeVisible)
Debug.Print cell.Value
Next cell
'sort
lColData = wsData.Cells(1, Columns.Count).End(xlToLeft).Column
wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes ' returns error because of SpecialCells
End Sub
"Run-time error '1004': This can't be done on a multiple range selection. Select a single range and try again." This occurs in the last line, in
wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).SpecialCells(xlCellTypeVisible).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes. It only happens when I use SpecialCells(xlCellTypeVisible), so wsData.Range(wsData.Cells(1, 1), wsData.Cells(lRowData, lColData)).Sort Key1:=wsData.Range("B1:B100"), Order1:=xlDescending, Header:=xlYes works.
My thinking in using SpecialCells(xlCellTypeVisible) was that only then VBA would skip the filtered cells. I've tried it out, though, and to me it seems .Sort skips them anyway, with or without SpecialCells(xlCellTypeVisible) - can someone confirm this?
And this leads to my more general question: One thing I'm not quite clear on is when does Excel/VBA skip filtered rows and when it doesn't. To loop through the visible cells, I need to use SpecialCells(xlCellTypeVisible). With .Sort I (maybe) don't? And this question will always pop up for any operation I'll do on these filtered lists.
This made me wonder: should I work with my original sheet where part of the data is hidden or should I temporarily create a new sheet, copy only the data I need (= excluding the rows I've hidden with the filter) and then work with that? Would this new sheet make it quicker or easier in any way? What is better in your experience?
Your first error occurs when you attempt to copy nonadjacent cell or range selections e.g multiple nonadjacent rows within the same column (A1, A3, A5). This is because Excel "slides" the ranges together and pastes them as a single rectangle. Your visible special cells are nonadjacent, and therefore can't be copied as a single range.
It seems that excel is looping through all of the cells in your range, not just the visible ones. Your debug.print is returning more rows than just those that are visible.
I would take a different approach to tackling your problem by using arrays, which VBA is able to loop through extremely quickly compared to worksheets.
Using this approach, I was able to copy 9k rows with 10 columns based on the value of the first column from a sample size of 190k in 4.55 seconds:
EDIT: I did some messing around with the arrays which brought the time down to 0.45 seconds to copy 9k rows based on the first column from an initial 190k using the following:
Option Explicit
Sub update_column()
Dim lr1 As Long, lr2 As Long, i As Long, j As Long, count As Long, oc_count As Long
Dim arr As Variant, out_arr As Variant
Dim start_time As Double, seconds_elapsed As Double
Dim find_string As String
start_time = Timer
' change accordingly
find_string = "looking_for"
With Sheets("Sheet1")
' your target column in which you're trying to find your string
lr1 = .Cells(Rows.count, "A").End(xlUp).Row
lr2 = 1
' all of your data - change accordingly
arr = .Range("A1:J" & lr1)
' get number of features matching criteria to determine array size
oc_count = 0
For i = 1 To UBound(arr, 1)
If arr(i, 1) = find_string Then
oc_count = oc_count + 1
End If
Next
' redim array
ReDim out_arr(oc_count, 9)
' write all occurrences to new array
count = 0
For i = 1 To UBound(arr, 1)
If arr(i, 1) = find_string Then
For j = 1 To 10:
out_arr(count, j - 1) = arr(i, j)
Next j
count = count + 1
End If
Next
' write array to your target sheet, change sheet name and range accordingly
Sheets("Sheet2").Range("A1:J" & (oc_count + 1)) = out_arr
End With
seconds_elapsed = Round(Timer - start_time, 2)
Debug.Print (seconds_elapsed)
End Sub
It isn't super clean and could probably do with some refining, but if speed is important (which it often seems to be), this should do the job well for you.
As per bm13563 comment you are copying nonadjacent cells.
Also using a Sort will be altering your base data which could have an impact if you ever need to determine how it was initially ordered in the future.
Working with filters can become quite complex so a simpler (and not particularly slow) method could be to do a string search with your filtering value in your chosen column and then loop through the instances returned performing actions on each result.
The (slightly adapted) code below from David Zemens would be a good starting point (copied from Find All Instances in Excel Column)
Sub foo()
Dim fnd As String, FirstFound As String
Dim FoundCell As Range, rng As Range
Dim myRange As Range, LastCell As Range
Set huntRange = Range("A:B")
Set LastCell = myRange.Cells(myRange.Cells.Count)
Set FoundCell = myRange.Find(what:="January", after:=LastCell, LookIn:=xlValues)
If Not FoundCell Is Nothing Then
FirstFound = FoundCell.Address
Do
'Do your actions here, you can get the address of the found cell to return row etc.
MsgBox (FoundCell.Value)
Set FoundCell = myRange.FindNext(FoundCell)
Loop While (FoundCell.Address <> FirstFound)
End If
Set rng = FoundCell '<~~ Careful, as this is only the LAST instance of FoundCell.
End Sub
New to VBA
I'm confused as to why I need to run my module twice to get it to update my cells. My code:
Option Explicit
Sub m_Range_End_Method()
Dim lRow As Long
Dim lCol As Long
Dim currentRow As Long
Dim i As Integer
Dim rng As Range
Set rng = ActiveCell
Range("B:B").Select
lRow = Cells(Rows.Count, 1).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
Sheets("MySheet").Select
' Loop Through Cells to set description in each cell
Do While rng.Value <> Empty
currentRow = ActiveCell.Row
If InStr(rng.Value, "PETROL") = 0 Then
Set rng = rng.Offset(1)
rng.Select
Else
Worksheets("MySheet").Cells(currentRow, 5) = "Shopping"
Worksheets("MySheet").Cells(currentRow, 6) = "Car"
Set rng = rng.Offset(1)
rng.Select
End If
Loop
End Sub
On the first run what happens in Excel 2016 is that Column B gets highlighted and that's it. I then have to press "Run" again in visual basics editor for it to then update all the entries at which point column B gets unselected. All I want to do is update the cells at the currentRow of a specified worksheet. I've been reading but have got myself into some confusion, someone said I should use the
Range("B:B").Select
statement and for some reason the spreadsheet update works but only if I run it twice. Without this Range command, for reasons I don't understand, the spreadsheet doesn't update - all that happens is that the box selection moves to entries with Petrol and stays there with the program running but not updating.
The aim of the program is to find in a sheet all occurrences of a word in column B, in this initial case that is PETROL (I'm going to expand to include many others). For that match on the same row I want it to update columns 5 and 6 with descriptions. The excel spreadsheet will have hundreds of rows of entries with varying descriptions in column B.
Any help would be much appreciated.
I guess you have to run it twice because the first time you run it, the ActiveCell could be anything, and your loop depends on it not being empty to start with, but after the first run you have selected column B (and other things)...
Read this previous answer on avoiding the use of Select and Activate, it will make your code more robust: How to avoid using Select in Excel VBA macros
Revised Code
See the comments for details, here is a cleaner version of your code which should work first time / every time!
Sub m_Range_End_Method()
Dim col As Range
Dim rng As Range
Dim currentRow As Long
' Use a With block to 'Fully Qualify' the ranges to MySheet
With ThisWorkbook.Sheets("MySheet")
' Set col range to the intersection of used range and column B
Set col = Intersect(.UsedRange, .Columns("B"))
' Loop through cells in col to set description in each row
For Each rng In col
currentRow = rng.Row
' Check upper case value match against upper case string
If InStr(UCase(rng.Value), "PETROL") > 0 Then
.Cells(currentRow, 5) = "Shopping"
.Cells(currentRow, 6) = "Car"
End If
Next rng
End With
End Sub
I have created a macro however its not really working since the rows actually change during the delete. The user select any # of cells in a table. On run of the macros, just those rows which belong to the selected cells are deleted. Here is what I got to so far:
Sub DeleteSelectedRows()
Dim Cell As Range
With Sheet1
For Each Cell In Selection
.Range(Cell.Address).EntireRow.Delete
Next Cell
End With
End Sub
Any help would be greatly appreciated.
Do not use a For Each loop when modifying the collection, use a simpler For loop, starting at the last row index (or column index) and going backwards to the first index.
Make sure the loop is set to Step -1 to go backwards. The backwards direction is required because in Excel, when you delete a row/column, the remaining rows/columns move up/left, so all further indexes may be wrong after the first edit.
Dim rng as Range
Set rng = Selection
Dim firstRow as Integer
Dim lastRow as Integer
firstRow = rng.Row
lastRow = rng.Rows(rng.Rows.Count).Row
Dim i as Integer
For i = lastRow to firstRow Step -1
Call ActiveSheet.Rows(i).Delete()
Next i
In some (probably rare) cases, a user could ctrl+click to select a non-contiguous range. This code would account for that possibility, while still only deleting the rows that are actually selected:
Sub DeleteSelectedRows()
Dim rArea As Range
For Each rArea In Selection.Areas
rArea.EntireRow.Delete
Next rArea
End Sub