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)
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 filled B2:GQ244 with formulae, copied the range and pasted by value before sorting the range column by column. The cells in B8:GQ244 were all blanks. Then, I wanted to concatenate the non-blank cells column by column, starting from row 2. To do so, I needed to find the last non-blank cell in each column.
For some reason, both End(xlUp) and End(xlDown) gave row 244, which was empty. I can't figure out why. I thought the file might be corrupted. So, I copied the two sheets and the module to a newly created workbook to no avail. Any explanation why both End(xlUp) and End(xlDown) gave row 244?
.Range("B2:GQ244").Formula = "=IF(ISERROR(FIND( B$1,Sheet9!$H34)),"""",Sheet9!$I34)"
'paste by value to get rid of formulae
.Range("B2:GQ244").Copy
.Range("B2").PasteSpecial Paste:=xlPasteValues
'sort by column
Dim last_row As Long
Dim j As Long
For i = 2 To 200 Step 1
Range(.Cells(2, i), .Cells(245, i)).Sort key1:=.Cells(2, i), order1:=xlAscending
Next i
For i = 2 To 200 Step 1
last_row = .Cells(65536, i).End(xlUp).Row
last_row = .Cells(1, i).End(xlDown).Row
The code below will remove all null strings at the bottom of columns as well as those that contain zeroes.
Sub ClearBlankCells()
' 146
Dim Rng As Range ' working range
Dim R As Long ' intermediate: row
Dim C As Long ' loop counter: columns
Application.ScreenUpdating = False
With ActiveSheet
With .Range("B2:GQ244")
.Formula = "=IF(ISERROR(FIND( B$1,Sheet9!$H34)),"""",Sheet9!$I34)"
' replace formulas with their values
.Copy
.PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False
For C = 2 To 200 Step 1
Set Rng = .Columns(C)
R = Application.Evaluate("SUMPRODUCT((" & Rng.Address & "<>"""")*(" & _
Rng.Address & "<>0)*1)")
If R > 0 Then
Set Rng = Range(.Cells(R + 1, C), .Cells(Rows.Count, C))
Rng.ClearContents
End If
' sort by column
' Range(.Cells(2, C), .Cells(245, C)).Sort Key1:=.Cells(2, C), Order1:=xlAscending
Next C
End With
Application.ScreenUpdating = True
End Sub
Note that no blanks or zeroes may be included in the block of data above the bottom of each column, including the caption.
Sorting must be done after such cells have been removed but I left the sort instructions dimmed out because it's wrong either in syntax or by concept. If you need to sort each column the syntax is wrong because the syntax sorts the entire sheet. On the other hand, if you want to sort the entire sheet you don't have to do it in a loop 200 times.
The code runs very slowly which gives rise to two observations.
It spends 99% of its time repairing the damage it has done in its first line.
It looks at a data range which is vastly bigger than what is actually, reasonably, required. Nobody wants to look at a sheet 200 columns and 244 rows.
Therefore there must be much better ways to do achieve what you want.
I can't confirm your findings. Having a blank ActiveSheet and a blank Sheet9 the code below filled the ActiveSheet with zeroes B2:GQ244. It then read the last row xlUp as 244 and xlDown as 2. Both of these values are as expected. Perhaps you have a setting that suppresses the display of zeroes. However, as explained in my comment above, a cell that appears blank isn't necessarily blank and that would also apply to a cell containing a NullString inserted by your formula, even if the formula was subsequently removed leaving the null string in its place.
Sub Examine()
Dim last_row As Long
Dim i As Long
With ActiveSheet
.Range("B2:GQ244").Formula = "=IF(ISERROR(FIND( B$1,Sheet9!$H34)),"""",Sheet9!$I34)"
'paste by value to get rid of formulae
.Range("B2:GQ244").Copy
.Range("B2").PasteSpecial Paste:=xlPasteValues
'sort by column
For i = 2 To 200 Step 1
Range(.Cells(2, i), .Cells(245, i)).Sort Key1:=.Cells(2, i), Order1:=xlAscending
last_row = .Cells(.Rows.Count, i).End(xlUp).Row
Debug.Print last_row ' returns 244
last_row = .Cells(1, i).End(xlDown).Row
Debug.Print last_row ' returns 2
Next i
End With
End Sub
The only mystery remaining, therefore, is why .Cells(1, i).End(xlDown).Row gives you a value of 244. It doesn't. Therefore the solution must be in the conduct of your test, not in its result. Compare your testing method with the one I employed above.
situation is following:
I have 32 columns with data (various number of rows in columns) and need to delete cells with .value "downloaded" (always last cell in a column).
I have a code looping from column 32 to 1 and searching last_row for "downloaded" value. For 30 columns code seems to be working flawlessly but 2 columns return last_row value 1 even though there are multiple values (in fact hundreds of them) but they are non existent for VBA code.
Code:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
last_row = ws.Cells(Rows.Count & Last_Col).End(xlUp).Row
For R = Last_Col To 1 Step -1
With ws
Last_Col = R
last_row = ws.Cells(.Rows.Count & Last_Col).End(xlUp).Row
If Cells(last_row, Last_Col).Value Like "*Downloaded*" Then
Cells(last_row, Last_Col).ClearContents
End If
End With
Next R
Data is being drained from another worksheets. For 2 columns where I experience an error, I manually deleted values and inserted another, random batch of values and code worked as intended.
Checked columns formatting, worksheets from which data is taken but I struggle to find a solution.
Thank you for your help.
Clear Last Cell If Criteria Is Met
The main mistake was using Cells(.Rows.Count & Last_Col), where .Rows.Count & Last_Col would have resulted in a 8 or 9-digit string, while it should have been ws.Cells(ws.Rows.Count, Last_Col).End(xlUp).Row which was pointed out by chris neilsen in the comments.
Another important issue is using ws. in front of .cells, .rows, .columns, .range, aka qualifying objects. If you don't do it and e.g. the wrong worksheet is active, you may get unexpected results.
There is no need for looping backwards unless you are deleting.
Although it allows wild characters (*, ?), the Like operator is case-sensitive (a<>A) unless you use Option Compare Text.
The first solution, using the End property, will fail if a number of last columns is hidden or if you insert a new first row e.g. for a title.
The second solution, using the Find method (and the first solution), may fail if the data is filtered.
The Code
Option Explicit
Sub clearLastEnd()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim LastCol As Long
LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Dim LastRow As Long
Dim c As Long
For c = 1 To LastCol
LastRow = ws.Cells(ws.Rows.Count, c).End(xlUp).Row
With ws.Cells(LastRow, c)
If InStr(1, .Value, "Downloaded", vbTextCompare) > 0 Then
.ClearContents
End If
End With
Next c
End Sub
Sub clearLastFind()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1")
Dim cel As Range
Set cel = ws.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
Dim c As Long
For c = 1 To cel.Column
Set cel = Nothing
Set cel = ws.Columns(c).Find(What:="*", _
SearchDirection:=xlPrevious)
If Not cel Is Nothing Then
If InStr(1, cel.Value, "Downloaded", vbTextCompare) > 0 Then
cel.ClearContents
Else
' The current last non-empty cell does not contain criteria.
End If
Else
' Column is empty.
End If
Next c
Else
' Worksheet is empty.
End If
End Sub
EDIT:
So you are curious why it worked at all. The following should shed a light on it:
Sub test()
Dim i As Long
Debug.Print "Right", "Wrong", "Rows.Count & i"
For i = 1 To 32
Debug.Print Cells(Rows.Count, i).Address, _
Cells(Rows.Count & i).Address, Rows.Count & i
Next i
End Sub
In a nutshell, Cells can have 1 or 2 arguments. When 1 argument is used, it refers to the n-th cell of a range, and it 'counts' by row. The more common usage is with 2 arguments: rows, columns. For example:
Cells(5, 10) ' refers to cell `J5`.
Using one argument is inconvenient here:
Cells(16384 * (5-1) + 10)
i.e.
Cells(65546)
It may be convenient when processing a one-column or a one-row range.
Well , let me see if i understand you have a table in worksheet table have 32 columns and X rows (because you only put WS and i can know if is WS=worksheet or WS= Table-range)
for this i am going to say is selection (if you put worksheet only hace to change for it)
in your code put:
Last_Col = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
but in this you always wil obtein 1st cell so i dont understand why exist?
WS.columns.count
return number of columns you selection have
.End(xlToLeft)
return last cell if star to move to left (like Ctrl - left key)
so
Last_Col ---first go to cells (1,ws.Columns.Count) then go to left (End(xlToLeft)) and the end return number of column where finish (.Column) in this case you always get cell (1,"first column of your table")
NOTE: because you wrote that you have allways value in your cells (I have 32 columns with data (various number of rows in columns)
And for Row you have same question
Then you Wrote you want "Delete" but in your code you put Erase value (.ClearContents) so what do you want? because both are no equal
BUT if you have a table and want to search in any cells that have "Download" and only want to "clear content" you just may to use ".find" instead; or if you want to do all at same time you can use .replace (need to check before if .find return "nothing" or no , because if return nothing you get error)
If you have a table with 32 columns and each row have one cell where you put "Donloaded" and want to "delete" all row your code only need select column where appear "downloaded" (example Column "status").
If you have a table where any cell can take value "downloaded" and want to "delete" that cell you need to take care to resize your table and "move to" (when you delete cells you need to say where you want to move yor data remain "letf, "rigth", "up", down).
However if you say that "Downloaded" always appear in last row you can use For to change for all columns and use .end(xlDown)
For i=1 to 32
if cells(1,i).end(xlDown).value="downloaded" then cells(1,i).end(xlDown).ClearContents
next
BUT you need put more information because if you cant garantize that all cells have values and exist cells with "nothing" you will need
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.
Was wondering if someone could help me problem solve something with the attached example dataset. I have many more so trying to work out an efficient way to do this:
https://www.dropbox.com/s/fa32ddeh4lbz8lo/Problem%20removing%20blanks%20cells%20and%20corresponding%20left%20cell.xlsx?dl=0
In the attached excel data sheet are sets of 2 columns side-by-side marked by lines (TIME and GLU). I have used conditional formatting to highlight (in red) the blank cells in each GLU columns. What I want to do (without having to go through by hand...) is remove these blank cells (i.e. delete and move that whole column upwards) AND also delete and move upwards the single 'TIME' cell immediately to the left of each of these blank cells (as illustrated for example by the green highlighted TIME cells in column A alongside column B).
Does anyone out there know how this might be achieve via code?? Would be extremely helpful!!
Thanks in advance!
Patrick
Sub RemoveBlank()
Dim sht As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim Column As Long
Application.ScreenUpdating = False
Set sht = ThisWorkbook.Worksheets("Sheet1")
LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
Column = 2
Do While Column <= LastColumn
LastRow = sht.Range(Cells("1", Column - 1), Cells("1", Column - 1)).CurrentRegion.Rows.Count
Row = LastRow
Do While Row > 1
If sht.Range(Cells(Row, Column), Cells(Row, Column)).Value = "" Then
'Delets the two column row with a blank GLU and moves the rest of the data up.
sht.Range(Cells(Row, Column - 1), Cells(Row, Column)).Select
Selection.delete Shift:=xlUp
Else
'Do nothing
End If
Row = Row - 1
Loop
Column = Column + 2
Loop
Application.ScreenUpdating = True
End Sub