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
Related
I have financial data where some rows are blank and id like to be able to delete the entire row IF entire rows in a selected range are blank (its important for it to be in selected range as I might have "Revenues" in column A but then I have column B-D be blank data (no numbers basically)).
I'd like for it to apply to a selected range, instead of having a predetermined range in the code (for the code to be flexible).
I am trying to use this format but it doesnt seem to be working:
Sub deleteBlankRows()
Dim c As Range
On Error Resume Next
For Each c In Selection.Row.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next
End Sub
Any thoughts would be welcome.
Loop trough each complete row of selection and check if the count of blank cells matchs the count of all cells in row:
My code:
Dim rng As Range
For Each rng In Selection.Rows
If Application.WorksheetFunction.CountBlank(rng) = rng.Cells.Count Then rng.EntireRow.Delete
Next rng
After executing code:
The emtpy row is gone
UPDATE:
#VasilyIvoyzha is absolutely right. For each won't work properly on this situation. A better approach would be:
Dim i&, x&, lastRow&
lastRow = Range(Split(Selection.Address, ":")(1)).Row
x = Selection.Rows.Count
For i = lastRow To Selection.Cells(1).Row Step -1
If WorksheetFunction.Concat(Selection.Rows(x)) = "" Then Rows(i).Delete
x = x - 1
Next i
This way will delete empty rows on selection, even if they are consecutive.
I'm looking for a macro to delete duplicates in a column, regarding their last value
e.g.
DES_FFAs_556
asda_FRF_556
Because 556 is same, it should be deleted.
right now im getting the last 4 digits of each cell but i dont know how to remove duplicates with it
Sub duplicates()
Dim i As Long
Dim res As String
Dim WB As Workbook
Dim WS As Worksheet
Dim total As Long
Set WB = Workbooks("MQB37W - SW Architecture Matrix_Nw")
Set WS = WB.Sheets("SW Architecture Main - In...")
With WS
total = .Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To total
res = Right(Cells(i, "A").Value, 4)
WS.Range("A4:total").RemoveDuplicates Columns:=1, Header:=xlNo
Next
End With
End Sub
You do not need VBA for this. You can just use code from this tutorial in a new column and than based on that column you can filter, conditional format or delete rows. If you would like to indicate only rows after the first occurrence you can use COUNTIF. Ofcourse if you need VBA for something else you can apply the same logic I described above inside the VBA code.
Currently have a macro which counts the number of rows to use as a variable. Due to new data source which has blank rows this no longer functions.
I need it to continue counting until it hits two blanks which is the end of the data source but also include the blank rows in the count.
I have a macro that counts the number of rows to provide a variable for a separate macro which uses that number for a loop function. Everything was working fine except the new data to count has blank row in between data (which must remain and included in the total row count).
I can figure out how to count non-blanks and full cells separately but can't figure out how to do it together. Any suggestions?
Sub num_rows(nrows As Variant)
Dim numrows
Dim ra As Range
Dim i As Integer
'get number of rows between blank cells
Sheets("4 Gantt Overview").Activate
Set ra = Range("b7")
numrows = Range(ra.Address,Range(ra.Address).End(xlDown)).rows.Count
Range(ra.Address).Select
'establish counting loop
For i = 1 To numrows
ActiveCell.Offset(1, 0).Select
Next
nrows = numrows
Range("b7").Select
End Sub
For a data set of 130 rows and 2 blanks its counting only to 30 rows (the first blank position).
Imagine the following data:
If you want to find the first 2 blanks, you can use .SpecialCells(xlCellTypeBlanks) to fund all blanks in your range (here column A). It will turn something like the selected cells in the image. There are 6 selected areas that you can access with .SpecialCells(xlCellTypeBlanks).Areas.
So if we loop through all these areas For Each Area In .Areas and check their row count If Area.Rows.Count >= 2, we can easily find the area with 2 rows (or at least 2 rows).
The amount of rows (empty or not) is then Area.Row - AnalyzeRange.Row
So we end up with:
Option Explicit
Sub TestCount()
MsgBox CountRowsUntilTwoBlanks(Worksheets("Sheet1").Range("A:A"))
End Sub
Function CountRowsUntilTwoBlanks(AnalyzeRange As Range) As Long
Dim Area As Range
For Each Area In AnalyzeRange.SpecialCells(xlCellTypeBlanks).Areas
If Area.Rows.Count >= 2 Then 'if 2 or more then use >=2, if exactly 2 use =2
CountRowsUntilTwoBlanks = Area.Row - AnalyzeRange.Row
Exit For
End If
Next Area
End Function
So for this example it will return 16 rows.
Note that if your goal is to find the last used row, which in this example would be row 20 then you could just use …
Dim LastRow As Long
With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
… to find the last used row in column A. Here LastRow returns 20.
This this macro. It will find first cell that is blank with a following cell blank as well.
Sub stopAtDoubleBlank()
Dim i As Long
i = 2
Do While Range("A" & i).Value <> "" Or Range("A" & i + 1) <> ""
i = i + 1
Loop
MsgBox i
End Sub
You can try something like this too if you want:
Sub lastrow()
Dim lr As Long
lr = ActiveSheet.Rows.Count
Cells(1, lr).Select
Selection.End(xlUp).Select
lr = ActiveCell.Row
End Sub
(go down to the very bottom and jump up to the last not empty row in A cloumn(that can be changed) also you can add something like +1 if you want an empty row at the end)
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 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