I am trying to write code that will loop through all cells in a range. Eventually I want to do something more complicated, but since I was having trouble I decided to create some short test programs. The first example works fine but the second (with a named range) doesn't (gives a "Method Range of Object_Global Failed" error message). Any ideas as to what I'm doing wrong? I'd really like to do this with a named range... Thanks!
Works:
Sub foreachtest()
Dim c As Range
For Each c In Range("A1:A3")
MsgBox (c.Address)
Next
End Sub
Doesn't work:
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In Range("Rng")
MsgBox (c.Address)
Next
End Sub
Set Rng =Range("A1:A3") is creating a range object, not a named range. This should work
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In rng
MsgBox (c.Address)
Next
End Sub
If you want to create a Named Range called Rng then
Range("A1:A3).Name="Rng"
will create it or you can create and loop it like thsi
Dim c As Range
Range("a1:a3").Name = "rng"
For Each c In Names("rng").RefersToRange
MsgBox c.Address
Next c
To adjust your second code, you need to recognize that your range rng is now a variable representing a range and treat it as such:
Sub foreachtest2()
Dim c As Range
Dim Rng As Range
Set Rng = Range("A1:A3")
For Each c In rng
MsgBox (c.Address)
Next
End Sub
Warning: most of the time, your code will be faster if you can avoid looping through the range.
Try this, instead:
Sub foreachtest2()
Dim c As Range
Range("A1:A3").Name = "Rng"
For Each c In Range("Rng")
MsgBox (c.Address)
Next
End Sub
Related
I have a For Each Loop that looks for cells that contain a string with a wildcard and if that string is not bold. If those conditions are met then that cell's row is deleted. I believe the For Each Loop is inefficient, and even with only around 200 rows the code takes a few seconds to run. Is there a more efficient way to achieve these results?
Dim Cell As Range
Dim sheetRange As Range
Set sheetRange = ActiveSheet.UsedRange
For Each Cell In sheetRange
Set Cell = sheetRange.Find(What:="Total*", lookat:=xlPart)
If Not Cell Is Nothing Then
If Cell.Font.Bold = False Then
Cell.EntireRow.Delete
End If
End If
Next Cell
Please take a look at the code below and see if you can adapt it to your specific use case. The DeleteTotalRows subroutine uses the built-in .Find method to jump specifically to cells that include the value 'Total'. It passes each of these cells to the MergeDeleteRange subroutine. This sub will build a range to delete, which contains all rows with the Total word and bold font.
Report back if you run into issues.
Option Explicit
Sub DeleteTotalRows()
Dim fnd As Range
Dim rngToDelete As Range
Dim firstFnd As Range
Dim sht As Worksheet
'Update this
Set sht = Worksheets("Sheet2")
With sht
Set fnd = .Cells.Find(what:="Total", lookat:=xlPart)
If fnd Is Nothing Then Exit Sub
Set firstFnd = fnd
Do
MergeDeleteRange rngToDelete, fnd
Set fnd = .Cells.Find(what:="Total", lookat:=xlPart, after:=fnd)
Loop While fnd.Address <> firstFnd.Address
End With
If rngToDelete Is Nothing Then Exit Sub
rngToDelete.Delete
End Sub
Private Sub MergeDeleteRange(ByRef outputRng As Range, ByRef inputCell As Range)
'Not deleting if the cell isn't bold
If Not inputCell.Font.Bold Then Exit Sub
'Create output range if it's still empty
If outputRng Is Nothing Then Set outputRng = inputCell.EntireRow
'Since you are testing multiple columns, confirm that the
'row isn't already in the output range
If Not Intersect(inputCell, outputRng) Is Nothing Then
Exit Sub
End If
Set outputRng = Union(outputRng, inputCell.EntireRow)
End Sub
Scenario: Range is named "Dog" and the named range Dog refers to A1:D4. The active cell is in cell B3, which is within the named range.
Is it possible to get the name of the named range that the active cell is in? ie return the name "Dog"?
Perhaps something like the following, which tests the Intersection of the ActiveCell and each named range.
The On Error Resume Next...On Error GoTo 0 is necessary since Intersect will fail when the ActiveCell and the named range are on different sheets, or if n is not a named range but if it refers to a constant or formula, for example.
Sub test()
Dim n As Name
For Each n In ActiveWorkbook.Names
Dim rng As Range
Set rng = Nothing
On Error Resume Next
Set rng = Intersect(ActiveCell, n.RefersToRange)
On Error GoTo 0
If Not rng Is Nothing Then
Debug.Print n.Name
End If
Next
End Sub
This should be a more robust way...
Sub Test()
MsgBox NamesUsedBy(ActiveCell)
End Sub
Function NamesUsedBy(r As Range)
Dim s$, n
On Error Resume Next
For Each n In ThisWorkbook.Names
If Intersect(r, Evaluate(Mid(n, 2))).Row Then
If Err = 0 Then s = s & ", " & n.Name
End If
Err.Clear
Next
NamesUsedBy = Mid(s, 3)
End Function
There is probably a more elegant way of doing this, but this should work.
Sub test()
Dim currentrange As Range
Dim r As Variant
Set currentrange = ActiveCell
For Each r In ThisWorkbook.Names
If Not Application.Intersect(currentrange, Range(Right(r, InStr(1, r, "$")))) Is Nothing Then
Debug.Print r.Name
End If
Next r
End Sub
I'm trying to delete rows in table if there is no value in a certain column.
I've used a code that deletes rows if there is one cell value missing, but I would like to delete rows if a cell does not contain a value in a certain column.
For example, if there is no value in Column G Row 5 then I want to delete the entire row.
Sub Test2()
Dim rng As Range
On Error Resume Next
Set rng = Range("Table3").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.Delete Shift:=xlUp
End If
End Sub
This deletes all rows with any type of missing cell value.
Two small changes:
Sub Test2()
Dim rng As Range
On Error Resume Next
Set rng = Range("G:G").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not rng Is Nothing Then
rng.EntireRow.Delete Shift:=xlShiftUp
End If
End Sub
EDIT:
If you want to work directly with the table, then consider iterating over the ListRows of the table in question, something like this:
Sub Test2()
Dim myTbl As ListObject
Set myTbl = Sheet1.ListObjects("table3") ' change sheet as necessary
Dim indx As Long
indx = myTbl.ListColumns("ColumnName").Index
Dim rngToDelete As Range
Dim myRw As ListRow
For Each myRw In myTbl.ListRows
If IsEmpty(myRw.Range(1, indx).Value) Then
If rngToDelete Is Nothing Then
Set rngToDelete = myRw.Range
Else
Set rngToDelete = Union(rngToDelete, myRw.Range)
End If
End If
Next myRw
If Not rngToDelete Is Nothing Then
rngToDelete.Delete Shift:=xlShiftUp
End If
End Sub
Note: Technically, it's xlShiftUp, not xlUp.
I have formulas throughout a workbook that are returning an output if matched with X and "" if not. I am new to VBA and macro's and unsure of where to begin. But my goal is to have a macro that I could run that clears the formula if it is blank or "" across multiples sheets. I would note, I only want it to do this in certain columns of each sheet.
Example:
Sheet 1 has the formula in cells H10:K20, while Sheet 2 has the formula in AV8:AV400, etc. etc. The goal being to have it recognize "Sheet 1" is a range of H10:K20 where it would erase, Sheet 2 is AV8:AV400.
Any help would be greatly appreciated!
I had found another question that was kind of similar, but I could not figure out how to make it recognize different sheet names or specific ranges within my file. I have pasted the code I had found and tried to use below as well as the link here.
How to clear cell if formula returns blank value?
Sub ClearCell()
Dim Rng As Range
Set Rng = ActiveSheet.Range("A1")
Dim i As Long
For i = 1 To 10
If Rng.Cells(i,1) = "" Then
Rng.Cells(i,1).ClearContents
End If
Next i
End Sub
Maybe something very basic:
Sub ClearEmptyFormulas()
Dim ws As Worksheet
Dim rng As Range, cl As Range
For Each ws In ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")) 'Extend the array or loop all worksheets
Select Case ws.Name
Case "Sheet1"
Set rng = ws.Range("H10:K20")
Case "Sheet2"
Set rng = ws.Range("AV8:AV400")
'Etc
End Select
For Each cl In rng
If cl.Value = "" Then
cl.ClearContents
End If
Next cl
Next ws
End Sub
Or even a bit simpler:
Sub ClearEmptyFormulas()
Dim rng As Range, cl As Range
Dim arr1 As Variant: arr1 = Array("Sheet1", "Sheet2")
Dim arr2 As Variant: arr2 = Array("H10:K20", "AV8:AV400")
For x = 0 To 1
Set rng = Sheets(arr1(x)).Range(arr2(x))
For Each cl In rng
If cl.Value = "" Then
cl.ClearContents
End If
Next cl
Next x
End Sub
I'm trying to find some macro that will run all over the worksheet and select all the relevant cells.
I have written some macro that find the cell but only one cell-its not selecting all the cells.
Dim myRange As Range
Dim myCell As Range
Set myRange = Range("A1:GG1000")
Dim mynumer As Integer
mynumber = 7
For Each myCell In myRange
If myCell = mynumber Then
myCell.Select
End If
Next myCell
how i can run the macro and see all the relevant cells?
thanks!
Maybe try some .FindNext iteration.
Just adapted from the above link:
Sub Test()
Dim cl As Range, rng As Range
With ThisWorkbook.Sheets("Sheet1").Range("A1:GG1000")
Set cl = .Find(7, LookIn:=xlValues, lookat:=xlWhole)
If Not cl Is Nothing Then
firstAddress = cl.Address
Do
If Not rng Is Nothing Then
Set rng = Union(rng, cl)
Else
Set rng = cl
End If
Debug.Print rng.Address
Set cl = .FindNext(cl)
If cl Is Nothing Then
GoTo DF
End If
Loop While cl.Address <> firstAddress
End If
DF:
rng.Select
End With
End Sub
The question really is, why do you .Select a range? Most of the time that can be avoided, and most likely the code above can be amended to something much cleaner!
Please take a look at this answer:
How to find a value in an excel column by vba code Cells.Find
The answer beneath the top voted, shows you how to search in the whole spreadsheet.
Best regards,
Timo