I am trying to delete anything in column B that has a blank in it. A1:A10 = {3,1,10,1,1,10,2,2,2,10}. When I run my code I get a error at the delete row line. It's a "runtime 1004 error, no cells found." There clearly should have been some cells found. What is going on? I have seen some people suggest putting an On Error clause around the delete row, but that just results in nothing getting deleted.
Sub test()
Dim Total_Rows As Integer
Dim rng As Range
Total_Rows = 10
Range("B1", "B" & Total_Rows) = "=if(A1=10,"""",1)"
Range("B1", "B" & Total_Rows).Copy
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Set rng = Range("B1", "B" & Total_Rows)
rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
You could try looping through the range like below
For Each cell In rng
If cell.Value = "" Then cell.EntireRow.Delete
Next cell
instead of finding a blank cell
Try this:
rng.AutoFilter 1, "="
rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False '~~> removes the filter
This filter out blanks or zero length strings then deletes it.
Or you can directly filter A1:A10 like this:
Range("A1:A10").AutoFilter 1, 10
Range("A1:A10").SpecialCells(xlCellTypeVisible).EntireRow.Delete
ActiveSheet.AutoFilterMode = False
Related
When my data are raw and unfiltered I can select them and Selection.Rows.Count returns the valid number.
After the AutoFilter it returns a number as if I selected the rows that were not visible, even though Selection.Copy does not copy other than selected rows.
How do I get the valid count of selected rows?
I tried Selection.SpecialCells(xlCellTypeVisible).Rows.Count.
EDIT
I use filter in another macro and then select by hand rows I want to add to another sheet.
I did two buttons, one to filter my table and the second to move selected rows to another sheet.
Sub ajout_commande()
Set DataSheet = ThisWorkbook.Worksheets("Prepa Commandes")
Dim a As Range, b As Range
Set a = Selection
i = 0
s = Selection.SpecialCells(xlCellTypeVisible).Count
For Each b In a.Rows
i = i + 1
DataSheet.Cells(6, 1).EntireRow.Insert
DataSheet.Range("A1:Z1").Copy DataSheet.Cells(6, 1).EntireRow
Next
Dim r1 As Range, r2 As Range, r3 As Range
Let copyrange1 = "E1" & ":" & "I" & i
Let copyrange2 = "BK1" & ":" & "BM" & i
Set r1 = a.Range(copyrange1)
Set r2 = a.Range(copyrange2)
Set r3 = Union(r1, r2)
r3.Copy
DataSheet.Cells(6, 1).PasteSpecial xlPasteValues
MsgBox s & " and " & i
End Sub
Here my table is filtered and I want to add selected rows to another sheet but the Selection.Rows.Count returns more rows than I selected because it counts the non visible rows, even though Selection.copy works.
For this example Selection.Rows.Count = 28 because of non visible rows between rows 10 and 20, 21 and 25 etc.
Is there a function to get the number I want (on this image 16)?
It depends on how you are using it. This works just fine for me
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
'~~> Specifying the complete address is the key part
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=YOURFIELDNUMBER, Criteria1:=YOURCRITERIA
Debug.Print .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
Test
Sub Sample()
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
With Range("A1:C6") '<~~ Filter, offset(to exclude headers)
.AutoFilter Field:=1, Criteria1:="Sid"
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Rows.Count
End With
'~~> Remove any filters
ActiveSheet.AutoFilterMode = False
End Sub
Well, the following would work if your selection was contiguous:
Selection.Columns(1).SpecialCells(xlCellTypeVisible).Count
However, from your screenshot I can see that your selections may be non-contiguous ranges (aka multiple areas selected), so you can use this function I created as a starting point:
Function countVisibleSelectedRows()
Dim count As Integer
count = 0
For Each Area In Selection.Areas
count = count + Area.Columns(1).SpecialCells(xlCellTypeVisible).count
Next
countVisibleSelectedRows = count
End Function
When you have multiple ranges selected, Excel calls each of those ranges an "area". In this function, we loop over each "area" in the Selection.Areas collection.
I know this is a late post to this question, but maybe this will help someone in the future. I find the following code snippet works well to count the number of visible rows in a range after being filtered.
Sub CountVisibleRows()
'only count the visible rows in the range
Dim lRow As Long, vis_lr As Long, DstWs As Worksheet
Set DstWs = ActiveSheet
lRow = DstWs.UsedRange.Rows.Count
'vis_lr = DstWs.Range("B2:B" & lRow).SpecialCells(xlCellTypeVisible).Count 'doesn't seem to work with non-contiguous rows
With DstWs
vis_lr = Application.WorksheetFunction.Subtotal(3, Range("B2:B" & lRow))
End With
Debug.Print vis_lr
End Sub
I'm running into trouble highlighting a column's used range. The following code creates copies of two worksheets, removes some values and then is supposed to highlight certain columns.
Sub CreateAnalysisSheets()
Dim cell, HlghtRng As Range
Dim i As Integer
Dim ref, findLast, findThis As String
Dim lastRow As Long
findLast = "2016"
findThis = "2017"
Application.ScreenUpdating = False
Sheets(1).Copy After:=Sheets(2)
ActiveSheet.Name = Left(Sheets(1).Name, InStr(1, Sheets(1).Name, " ")) & "Analysis"
Sheets(2).Copy After:=Sheets(3)
ActiveSheet.Name = Left(Sheets(2).Name, InStr(1, Sheets(2).Name, " ")) & "Analysis"
Sheets("RM Analysis").Select
For Each cell In ActiveSheet.UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
For Each cell In Range("1:1")
ref = cell.Value
lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row
Set HlghtRng = Range(Cells(1, cell.Column) & Cells(lastRow, cell.Column))
If InStr(1, ref, findLast) > 0 And InStr(1, ref, "YTD") = 0 Then
HlghtRng.Interior.ColorIndex = 8
End If
Next cell
For Each cell In Sheets(4).UsedRange
If cell.Value = "NULL" Then
cell.ClearContents
End If
Next cell
Sheets("RM Analysis").Select
Application.ScreenUpdating = True
End Sub
The problem comes at lastRow = Range("R" & Rows.Count & "C" & cell.Column).End(xlUp).Row where I get an Method 'Range' of Object '_Global' Failed. I've tried searching for ways to fix this issue, but everything I've tried (ActiveSheet.Range and Sheets("RM Analysis").Range) has yet to work.
Anyone see where I'm going wrong here?
The xlR1C1 syntax is fouling up your request for the last non-blank cell.
lastRow = Cells(Rows.Count, cell.Column).End(xlUp).Row
I would highly recommend that you avoid relying on the ActiveSheet and use explicit parent worksheet references. This can be made quite simple using With ... End With and preceding all Range and Cells with a . like .Range(...) or .Cells(...).
Once you within a With ... End With statement, all of the references need to be prefaced with a .. Additionally, the following is not a string concatenation (e.g. &) but as .Range(starting cell comma ending cell) operation.
with worksheets("RM Analysis")
...
Set HlghtRng = .Range(.Cells(1, cell.Column), .Cells(lastRow, cell.Column))
...
end with
this should do
Columns(1).Interior.ColorIndex = 3
change the number of column as to the column you wanna highlit
I have a formula that shows which rows in a specific column meet a set of criteria. When the formula is executed and applied to all rows, I run a loop to check which rows returned a value as a text, and then copy-pastes this cells to another worksheet:
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Range(.Cells(c.Row, "AF"), .Cells(c.Row, "AF")).Copy
Else
GoTo nextc
End If
With Worksheets("Sheet2")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With
nextc:
Next c
End With
Application.CutCopyMode = False
End Sub
What I want to do now is to run the formula for 631 different names, copy-paste every name as a headline and then run loop1. I cant figure out though how to make the for loop work inside the formula.
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Select
Range("AC2").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R2C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Range("AC2").Select
Selection.AutoFill Destination:=Range("AC2:AC20753")
Range("AC2:AC20753").Select
Range("AG2").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
Selection.Font.Bold = True
Sheets("Sheet1").Select
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
The cells that need to be changed for every loop are, R2C33 to something like RiC33 (which doesn't work) and the "headline" Range("AG2").Select to something like Range("AGi").Select.
Anyone who could help?
The following code will do the trick:
Sub loop2()
Dim i As Integer
For i = 2 To 632
Sheets("Sheet1").Range("AC2:AC20753").FormulaR1C1 = _
"=IF(RC[-3]=""district1"",(IF(RC[2]=R" & i & "C33 ,(IF(RC[-18]>=1,0,(IF(RC[-16]>=1,0,IF(RC[-14]>=1,0,IF(RC[-12]>=1,0,IF(RC[-10]>=1,1,IF(RC[-8]>=1,1,IF(RC[-6]>=1,1,0))))))))),0)),0)"
Sheets("Sheet1").Range("AG" & i).Copy Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet2").Range("A1").Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
End Sub
In order to let i be used within your String formula you have to stop the String " use & i & and continue the String ".
I have also changed your code to prevent the use of .Select, which is a no no in VBA.
This way it fills in your Formula copy's and changes the Font without selecting anything or changing sheets.
As Jeep noted you do however need to change Sheets(""Sheet2").Range("A1") as I don't know which cell you want to paste into.
Your first sub procedure might be better like this.
Sub loop1()
Dim r As Range, c As Range
With Worksheets("Sheet1")
Set r = Range(.Range("AF2"), .Range("AF2").End(xlDown))
For Each c In r
If WorksheetFunction.IsText(c) Then
Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) = _
.Cells(c.Row, "AF").Value2
End If
Next c
End With
End Sub
Direct value transfer is preferred over a Copy, Paste Special, Values.
In the second sub procedure, you don't have to do anything but remove the 2 from R2C33; e.g. RC33. In xlR1C1 formula construction a lone R simply means the row that the formula is on and you are starting at row 2. You can also put all of the formulas in at once. Once they are in you can looop through the G2:G632 cells.
Sub loop2()
Dim i As Integer
With Sheets("Sheet1")
.Range("AC2:AC20753").FormulaR1C1 = _
"=IF(OR(AND(RC[-3]=""district1"", RC[2]=R2C33, RC[-18]>=1), SUM(RC[-16], RC[-14], RC[-12])>=1), 0, IF(SUM(RC[-10], RC[-8], RC[-6])>=1, 1, 0))"
For i = 2 To 632
.Range("AG" & i).Copy _
Destination:=Sheets("Sheet2").Somewhere
Sheets("Sheet2").Somewhere.Font.Bold = True
Application.Run "'Customers.xlsb'!loop1"
Next i
Next i
End Sub
I also tightened up your formula by grouping some of the conditions that would result in zero together with OR and AND functions.
The only thing remaining would be defining the Destination:=Sheets("Sheet2").Somewhere I left hanging.
How can I use left formula to get shorted string(eg: BC150033) in column B?
pic above is the result I used Left formula. however I want to use vba to achieve this same result.
I know use for each next loop however something is wrong..
A B
1 BC150033-001 BC150033
2 BR165522-002 BR165522
3 ect....
Set SourceRange = Range(Sheets(2).Range("A1"), Selection.End(xlDown))
For Each cell In SourceRange
If IsEmpty(cell.Value) Then Exit For
Sheets(2).Range("B" & cell.Row).Value = Left(cell.Value, 8)
Next
Please advise
I think it's not the problem with Left. Try this one, I changed the way how you get SourceRange.
Sub test()
Set SourceRange = Range(Range("A1"), Range("A1").End(xlDown))
For Each cell In SourceRange
If IsEmpty(cell.Value) Then Exit For
Range("B" & cell.Row).Value = Left(cell.Value, 8)
Next
End Sub
I wrote this script to delete rows which contain a value in column C that is different than "201103". When I use this to bold it, it works, but when I use it with .Delete it behaves strange and does not work properly.
I was trying to get selected rows and than use UNION to merge it and use .SELECT (multiple) so I could delete it manually but not sure how to make it.
Sub test()
Dim Cell As Range
For Each Cell In Range("C2:C2308").Cells
If (Cell.Value <> "201103" And Cell.Value <> "") Then
Cell.EntireRow.Font.Bold = True
'Cell.EntireRow.Delete
End If
Next Cell
End Sub
Does anyone know how to fix it so it works fine?
Try this:
Sub test()
'
With ActiveSheet
.AutoFilterMode = False
With Range("C2", Range("C" & Rows.Count).End(xlUp))
.AutoFilter 1, "<>201103"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub