I'm trying to figure out a dynamic range that will select a range starting from the active cell in a for each loop. For instance, if cell A2 is selected in my for each cell loop, the range in the loop being A2:A20, and it contains "IP," it will select the range A2:M2, delete the contents, and shift all the values below, A3:M20, up to fill the emptied cells.
Sub deletewirelessdevice()
Dim rng As Range
Dim wksSource As Worksheet
Set wksSource = ActiveWorkbook.Sheets("dt-attext")
Set rng = wksSource.Range("A2:A500")
For Each Cell In rng
If InStr(1, ActiveSheet.Range(ActiveCell).Value, "IP") > 0 Then
Range(ActiveCell, "M" & ActiveCell.Row).Select.Delete Shift:=xlUp
Next Cell
End Sub
I'm not sure if there is a mistake in the selection and deletion as I can't get the code to run due to a Next without for compile error. There is a matching for so I don't know what the problem is. Any advice is welcome.
You had a number of issues with your code so I've tweaked it and inferred what you intended. This should work, however do read the comments above as well for some pointers on how to handle it next time
Public Sub deletewirelessdevice()
Dim DelRng As Range
Dim ColOffset As Long
With ActiveWorkbook.Sheets("dt-attext")
ColOffset = Range("M" & 1).Column - 1
For Each cell In .Range("A2:A500")
If InStr(cell.Value2, "IP") Then
If DelRng Is Nothing Then
Set DelRng = Range(cell, cell.Offset(0, ColOffset))
Else
Set DelRng = Union(DelRng, Range(cell, cell.Offset(0, ColOffset)))
End If
End If
Next cell
If Not DelRng Is Nothing Then DelRng.Delete Shift:=xlUp
End With
End Sub
Related
I'm trying to write a macro that removes rows with the condition that the string in the cells in column A contains "--" or "-4" or "" (empty). I'd do it with a normal filter, but that gives me max 2 conditions.
Sub Delete_Rows()
Dim cell As Range
For Each cell In Range("A:A")
If cell.Value = "*--*" Or cell.Value = "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End Sub
What am I doing wrong?
Please, test the next version. It uses an array for iteration and a Union range to delete rows at once, at the end of the code:
Sub Delete_Rows3Cond()
Dim sh As Worksheet, lastR As Long, rngDel As Range, arr, i As Long
Set sh = ActiveSheet
lastR = sh.Range("A" & sh.rows.count).End(xlUp).row
arr = sh.Range("A1:A" & lastR).Value2 'place the range in an array for faster iteration/processing only in memory
For i = 1 To UBound(arr)
If arr(i, 1) = "" Or arr(i, 1) Like "*--*" Or arr(i, 1) Like "*-4*" Then
addToRange rngDel, sh.Range("A" & i) 'create the union range
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete xlUp
End Sub
Private Sub addToRange(rngU As Range, Rng As Range) 'I creates the Union range
If rngU Is Nothing Then
Set rngU = Rng
Else
Set rngU = Union(rngU, Rng)
End If
End Sub
Deleting a row at a time, takes a lot of time and you need to process only the range containing data...
Please, send some feedback after testing it.
= checks for identical strings, so unless you have a cell containing "*--*" or "*-4*", the If-clause will never be true. You will have to use the like-operator:
If cell.Value like "*--*" Or cell.Value like "*-4*" Then
Two remarks:
Your code will loop through the whole Excel sheet (which contains 1'048'576 rows) so that will run a very long time. And, even worse, if you add the check for empty cells to delete a row, it will delete one million rows and it would look as if Excel/VBA is frozen. Therefore you need to figure out the last row before you run the code. More on this at Find last used cell in Excel VBA
And you need to be aware the that code will run on the active sheet - the sheet that currently has the focus. You should always specify the sheet (and workbook) where you want to code to work with. Don't go down the path to Select the sheet to make if active. For more details, see How to avoid using Select in Excel VBA
Sub Delete_Rows()
Dim cell As Range, lastRow As Long
' Replace the following line with the workbook you want to work with
With ThisWorkbook.Sheets(1)
lastRow = .Cells(.Rows.Count, "A").End(xlUp).row
For Each cell In .Range("A1:A" & lastRow)
If cell.Value Like "*--*" Or cell.Value Like "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End With
End Sub
You can use the Like operator instead of "=" to perform the comparison. Consider the following the code:
Sub Delete_Rows()
Dim cell As Range
For Each cell In Range("A:A")
If cell.Value Like "*--*" Or cell.Value Like "*-4*" Then
cell.EntireRow.Delete
End If
Next cell
End Sub
You can also read more about the like operator here for example: https://www.wallstreetmojo.com/vba-like/
I hope this helps :D
the aim of my problem is to find a specific value (Text) and then refer to the entire row (or even better only the used range to the right of my active cell) in a For/Each loop.
The first part works fine of finding my value, however, the code for targeting the row of the active cell (so the cell found by the find function), does not work yet:
Sub Search()
Dim cell As Range
Dim Count As Long
Set cell = Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
For Each cell In ActiveCell.EntireRow
If cell.Value = "0" Then
Count = Count + 1
End If
Next cell
Range("I1").Value = Count
End Sub
The following code will find the range to the right of your found cell and use your loop to do the comparision for each cell in the range. That part could probably be improved by using WorksheetFunction.CountIf.
Option Explicit
Sub Search()
Dim wks As Worksheet
Set wks = ActiveSheet
Dim cell As Range, sngCell As Range
Dim Count As Long
Set cell = wks.Cells.Find(what:="Planned Supply at BP|SL (EA)", LookIn:=xlValues, lookat:=xlWhole)
If cell Is Nothing Then Exit Sub ' just stop in case no hit
Dim rg As Range, lastColumn As Long
With wks
lastColumn = .Cells(cell.Row, .Columns.Count).End(xlToLeft).Column ' last used column in cell.row
Set rg = Range(cell, .Cells(cell.Row, lastColumn)) ' used rg right from found cell inlcuding found cell
End With
' loop from the original post
For Each sngCell In rg
If sngCell.Value = "0" Then
Count = Count + 1
End If
Next
Range("I1").Value = Count
End Sub
According to this website.
I think this should work:
Dim cell As Range
For Each cell In xxxSheet.Range("B:B").SpecialCells(xlCellTypeFormulas, xlNumbers)
'Do sth.
Next
which does not work. Is there something missing?
This should be working solution:
For Each cell In xxxSheet.Range("B:B")
If Not IsEmpty(cell) Then
'do sth
End If
Next
Also, if you want to loop until last filled cell, you could use following:
xxxSheet.Range("B1:B" & Cells(Rows.Count, 2).End(xlUp).Row)
instead of
xxxSheet.Range("B:B")
It does not work, because you do not have formulas on column B. Put some formulas and some constants and try this:
Option Explicit
Public Sub TestMe()
Dim myCell As Range
Dim myRange As Range
Set myRange = Worksheets(1).Columns("B:B").SpecialCells(xlCellTypeFormulas, xlNumbers)
For Each myCell In myRange
Debug.Print myCell.Address
Next
Set myRange = Worksheets(1).Columns("B:B").SpecialCells(xlCellTypeConstants, xlNumbers)
For Each myCell In myRange
Debug.Print myCell.Address
Next
End Sub
The first loop would print the addresses of the formula cells, the second the addresses of the constants.
This is the ozgrid explanation about SpecialCells:
http://www.ozgrid.com/VBA/special-cells.htm
The problem is SpecialCells(xlCellTypeFormulas, xlNumbers) is returning only cells with formulas that make numbers (ie. =1+2).
To keep things efficient, you only need to check up to the last filled row
For Each cell In xxxSheet.Range("B1", Cells(Rows.Count, 2).End(xlUp))
If Not IsEmpty(cell) Then
'Do sth.
End If
Next
If you really want you can use SpecialCells() to have a range containing no blanks to loop through. If you only have formulas or only constants, you could use SpecialCells(xlFormulas) or SpecialCells(xlConstants) respectively, but for a more general use case you will have to do do a combination of the two.
Dim cell As Range
Dim searchRange As Range
' SpecialCells errors when there aren't cells instead of giving a useful value
On Error Resume Next
Set searchRange = xxxSheet.Range("B:B").SpecialCells(xlFormulas)
Set searchRange = xxxSheet.Range("B:B").SpecialCells(xlConstants)
Set searchRange = Union(xxxSheet.Range("B:B").SpecialCells(xlConstants), _
xxxSheet.Range("B:B").SpecialCells(xlFormulas))
On Error GoTo 0
If searchRange Is Not Nothing Then ' Only continue if no blanks
For Each cell In searchRange
'Do sth.
Next
End If
I just want to know how to loop through the non blank cells on Column A. What I'm trying to do is copy the contents on [A1:B1] to be added on top of each non blank cells on Column A. So far I have counted the non blank cells on column A but I'm stuck. I know that an Offset function should be used for this.
Here's my code so far:
Dim NonBlank as Long
NonBlank = WorksheetFunction.CountA(Worksheet(1).[A:A])
For i = 1 to NonBlank
[A1:B1].Copy Offset(1,0). "I'm stuck here"
Next i
If you are trying to fill the headers for each Product, try this...
Sub FillHeaders()
Dim lr As Long
Dim Rng As Range
lr = ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
On Error Resume Next
Range("A1:B1").Copy
For Each Rng In Range("A3:A" & lr).SpecialCells(xlCellTypeConstants, 2).Areas
If Rng.Cells(1).Value <> Range("A1").Value Then
Rng.Cells(1).Offset(-1, 0).PasteSpecial xlPasteAll
End If
Next Rng
Application.CutCopyMode = 0
Application.ScreenUpdating = True
End Sub
As example to simulate the effect of Ctrl-Down from Cell A1 and display the Address, Value in the Immediate Window:
Sub HopToNextNonBlankCellBelow()
Dim oRng As Range
Set oRng = Range("A1")
Debug.Print "Cell Address", "Cell Value"
Do
Set oRng = oRng.End(xlDown)
If Not IsEmpty(oRng) Then Debug.Print oRng.Address(0, 0), oRng.Value
Loop Until oRng.Row = Rows.Count
Set oRng = Nothing
End Sub
Try this... I've (probably) overcounted the rows at 1000, but it likely won't make a difference with your performance. If you wanted to be more precise, there are hundreds of articles on how to find the last row of a range. As for the Offset function, it references a cell in relation to the one we're looping through. In the example below, the code is saying cell.offset(0,1) which means one cell to the right of the cell we are currently looping through. A clearer (less loopy!) example would be if you typed: Range("A10").offset(0,1) it would be the same as typing Range("B10")
Dim Cell As Range
For Each Cell In Range("A2:A1000").Cells
If Not IsEmpty(Cell) Then
Cell.Offset(0, 1).Value = Cell.Value
End If
Next Cell
I would like some support in correcting this simple piece of code. when running the code it is always displaying 1 and then a miss match error box pops up. I cant see why this is not working the code seems simple enough.
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
For Each cell In rng
If cell.Value > 0 Then
MsgBox Application.WorksheetFunction.CountA(cell.Value)
End If
Next cell
End Sub
Here is one way:
Sub Test3()
Dim rng As Range, cell As Range, IAmTheCount As Long
Set rng = Range("D1:D10")
IAmTheCount = 0
For Each cell In rng
If cell.Value > 0 Then
IAmTheCount = IAmTheCount + 1
End If
Next cell
MsgBox IAmTheCount
End Sub
Since you are using a for each loop, you are counting the cells one by one. That's why the Msgbox always says 1. You should not use a loop to achieve what you want
Sub Test3()
Dim rng As Range, cell As Range
Set rng = Range("D1:D10")
MsgBox Application.WorksheetFunction.CountIf(rng, ">0")
End Sub