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.
Related
How can I properly delete any columns where all the rows are blank except the first row (header)? Here's what I tried:
Sub deleteColumn ()
Dim TotalRange As Range
Dim col As Range
Set TotalRange = TotalRange.Offset(1, 0).Resize(TotalRange.Rows.Count - 1, _
TotalRange.Columns.Count)
Set col = Columns("A:D")
With TotalRange
If WorksheetFunction.CountA(col) = 0 Then
MsgBox "Empty"
Else
MsgBox "Not Empty"
End If
End With
End Sub
I have a spreadsheet export of all data in a database and some fields are not used. These fields are columns in the sheet and I need to delete the ones that have no data in the rows.
Thanks
Try this:
Sub deleteColumn ()
Dim TotalRange As Range, col As Range, x as long
Set TotalRange = ActiveSheet.UsedRange '<< need to set the range first
Set TotalRange = TotalRange.Offset(1, 0).Resize(TotalRange.Rows.Count - 1, _
TotalRange.Columns.Count)
'loop backwards over the columns in TotalRange
For x = TotalRange.Columns.Count to 1 step -1
set col = TotalRange.Columns(c)
If application.counta(col) = 0 then col.entirecolumn.delete
next x
End Sub
Just an idea. Editing on my cellphone, and can't test my code even if I write it down.
Use something like Range("A1").End(xlDown).Row to get the bottom-most row number in column A.
Check if (1). the found row number is the largest row number in your sheet, which you can get via ActiveSheet.Rows.Count. And (2). that cell is empty. Only when both 2 conditions are met, can we confirm we can delete column A.
Then you can add another loop to scan all the column areas you want to apply the find-and-delete method.
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)
I want to create a macro that would delete an entire row if all the cells in specific range (B to K in each of the 10 rows) are all empty. I tried the following:
Dim i As Integer
Dim rng As Range
For i = 1 To 10
Set rng = Range("B" & i, "K" & i).SpecialCells(xlCellTypeBlanks)
rng.EntireRow.Delete
Next i
If there are more following lines with empty cells, let's say 1 and 2, it deletes row 1 and move row 2 instead of the deleted one, so it becomes row 1. Then it skips the moved row, because i always increases so it never checks row 1 again. Is there any way to check if the row that was just deleted is really non-empty before moving to the next i?
Btw: I am using Excel 2013.
Instead of using the Special Cells, why not just use CountA()?
Sub t()
Dim i&
For i = 10 To 1 Step -1
If WorksheetFunction.CountA(Range("B" & i, "K" & i)) = 0 Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
That way, you can avoid any errors in case there's no blanks. Also, when deleting rows, it's recommended to start at the end, then Step -1 to the beginning.
Edit:
Try this as well, it may be quicker:
Sub T()
Dim rng As Range
Set rng = Range("B1:K10") ' Since you're going to loop through row 1 to 10, just grab the blank cells from the start
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Select ' Just to show you what's being selected. Comment this out in the final code
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
I recommend stepping through that with F8 first, to see how it works. In the range B1:K10, it will first select all rows where there's a blank cell. Then, it'll delete those rows.
I have a list in excel with about 20000 rows and 4 columns. This excel sheet contains names in bold, and the columns after that have information about them. After each name there is some excess information that takes up either 3 or 4 rows, but it's not consistent. I need to run through the sheet and delete all the rows where there isn't a bold name.
You need to create a macro the finds out how many rows are in the current worksheet and that then iterates through the rows from the bottom of the worksheet to the top checking to see if the Font.Bold property on the first column of the row is set to false. If so you delete that row.
The following works for me:
Sub DeleteUnboldRows()
Dim lastRow As Long
Dim currentRow As Long
'Select All the rows in the active worksheet
lastRow = ActiveSheet.UsedRange.Rows.Count
' Iterate through each row from the bottom to the top.
' If we go the other way rows will get skipped as we delete unbolded rows!
For currentRow = lastRow To 1 Step -1
'Look at the cell in the first column of the current row
' if the font is not bolded delete the row
If ActiveSheet.Rows(currentRow).Columns(1).Font.Bold = False Then
ActiveSheet.Rows(currentRow).Delete
End If
Next currentRow
End Sub
Here is a reference for the Bold property: http://msdn.microsoft.com/en-us/library/office/aa224034%28v=office.11%29.aspx
Sub deleteNonBolded()
Dim cell As Range
Dim selectRange As Range
For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
If (cell.Font.Bold = False) Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
selectRange.EntireRow.Delete
End Sub
A seemingly simple issue:
I have data in Columns A:E. Column E has some blank cells in some of the rows.
I would like to remove ALL THE ROW that include a blank cell in E. However, Here's the catch, there is other data in subsequent columns. if I delete the entire row, this data will be also deleted, which I don't want.
To be more specific, I need to:
(1) Check column E for blank cells
(2) When a blank cell if found, clear the row that has this cell, but only Columns A:E
(3) Shift the data in Columns A:E up
I tried:
Range("E2:E100").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
But this one only shifts data in column E, not the entire row.
of course, i can use:
Range("E2:E100").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
But like I said, this will delete data in subsequent columns, which I don't want.
Any tips?
Thanks,
Al
You can't shift the entire and leave some of the row behind, that is a contradiction. It sounds like you want to do this:
Range("A" & row & ":E" & row).Delete Shift:=xlUp
Where row is the row number you want to delete
To remove A:E in "chunks" but preserve you other columns intact a full solution is this
Sub PartKill2()
Dim rng1 As Range
Dim rng2 As Range
ActiveSheet.UsedRange
On Error Resume Next
Set rng1 = Columns("E").SpecialCells(xlBlanks)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
For Each rng2 In rng1.Areas
rng2.Cells(1).Offset(0, -4).Resize(rng2.Rows.Count, 5).Delete xlUp
Next
End Sub
If you wanted to delete the entire row where E was blank, and columns F:End were blank (but otherwise leave the row as is) then this more complex version can be used
Sub PartKill1()
Dim rng1 As Range
Dim lngCell As Long
Dim lngArea As Long
ActiveSheet.UsedRange
On Error Resume Next
Set rng1 = Columns("E").SpecialCells(xlBlanks)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
For lngArea = rng1.Areas.Count To 1 Step -1
For lngCell = rng1.Areas(lngArea).Cells.Count To 1 Step -1
If Application.CountA(Range(rng1.Areas(lngArea).Cells(lngCell).Offset(0, 1), Cells(rng1.Areas(lngArea).Cells(lngCell).Row, Columns.Count))) = 0 Then
rng1.Areas(lngArea).Cells(lngCell).EntireRow.Delete
End If
Next
Next
End Sub