The worksheet I'm working with has two cells filled in, one with Total and the other with value. They are next to each other. My goal is to catch the Total and print it's value. As I do not wish to know their specific cell address so I created a loop and did the job. I did it using .SpecialCells(xlCellTypeLastCell). Now, I would like to do the same using .UsedRange.
My question is: how can I do the same (creating the loop) using .UsedRange.
This is I have tried with (working one):
Sub FindTotalValue()
Dim rng As Range, cel As Range
'Set rng = ActiveSheet.UsedRange
'For Each cel In rng.Row
For Each cel In Range("A1", Range("A1").SpecialCells(xlCellTypeLastCell))
If InStr(cel.Value, "Total") > 0 Then MsgBox cel.Offset(0, 1).Value
Next cel
End Sub
As I know nothing about creating a loop using .usedrange method, I just commented them out within the script.
Give this a try:
Sub FindTotalValue()
Dim rng As Range, cel As Range
For Each cel In ActiveSheet.UsedRange.Cells.SpecialCells(2)
If InStr(cel.Value, "Total") > 0 Then MsgBox cel.Offset(0, 1).Value
Next cel
End Sub
It assumes that the cell containing "Total" is a constant, not a formula:
You should also investigate using Find() rather than a loop.
EDIT#1:
Based on Banana's suggestion:
Sub FindTotalValue()
Dim rng As Range, cel As Range
For Each cel In ActiveSheet.UsedRange.Cells.SpecialCells(2)
If InStr(cel.Value, "Total") > 0 Then
MsgBox cel.Offset(0, 1).Value
Exit For
End If
Next cel
End Sub
EDIT#2:
To use Find():
Sub FindTotalValueQuickly()
MsgBox Cells.Find(what:="Total", lookat:=xlPart).Offset(0, 1).Value
End Sub
Related
I was writing a program for deleting a row in a Selection with Empty Cell. I wrote the code and it worked well but it have a deficiency.
Code Is:
Dim i As Integer
Dim j As Integer
Dim Num As Integer
Num = Selection.Cells.Count
'MsgBox ("Num of Cells " & Num)
Selection.End(xlUp).Select
If (IsEmpty(ActiveCell)) Then
Selection.End(xlDown).Select
End If
For i = 1 To Num
If (IsEmpty(ActiveCell)) Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(-1, 0).EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Num = Num - 1
On Error GoTo Last
Else
ActiveCell.Offset(1, 0).Select
End If
Next
Last:
Exit
Now I was trying to rewrite the code with looping the cell in Range instead of above For loop:
Dim i As Integer
Dim j As Integer
Dim Num As Integer
Dim myRange As Range
ActiveSheet.Select
Set myRange = Selection.Cells
For Each myRange In Selection
If (IsEmpty(myRange)) Then
ActiveCell.EntireRow.Delete
On Error GoTo Last
Else
'ActiveCell.Offset(1, 0).Select
End If
Next myRange
Last:
Exit
This piece of code is not working Properly. Kindly put your Suggestions and rectify the Code
you could try
If WorksheetFunction.CountBlank(Selection) > 0 Then Intersect(Selection.SpecialCells(xlCellTypeBlanks).EntireRow, Selection.Columns(1)).EntireRow.Delete
Speciealcells seems to be easy to use.
Sub test()
Dim rngDB As Range
Set rngDB = Selection
On Error Resume Next
Set rngDB = rngDB.SpecialCells(xlCellTypeBlanks)
If Err.Number = 0 Then
rngDB.EntireRow.Delete
End If
End Sub
Here is an option that avoids relying on Selection and Select.
You can use a InputBox to determine the range. This will allow you to properly qualify all of your ranges/worksheets. You can then loop through the selected range and determine if the rows should be deleted (if blank).
At the end, delete all the rows at once. On larger operations, this will be much faster since you will only have 1 instance of deletion rather continuously deleting rows in the loop.
Option Explicit
Sub Blanks()
Dim MyRange As Range, MyCell As Range, DeleteMe As Range
Set MyRange = Application.InputBox("Select Range", Type:=8)
For Each MyCell In MyRange
If MyCell = "" Then
If DeleteMe Is Nothing Then
Set DeleteMe = MyCell
Else
Set DeleteMe = Union(DeleteMe, MyCell)
End If
End If
Next MyCell
If Not DeleteMe Is Nothing Then DeleteMe.EntireRow.Delete
End Sub
I'm trying to add a lookup formula to cells in a range where the word YES appears and leave the text in all other cells in the range as they are. My code is.
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
cel.Value = "=VLOOKUP(A1,H:I,2,0)"
End If
Next cel
End Sub
Unfortunately the cell reference 'A1' does not change as the formula is entered. Can anyone help please?
Here is simple solution to get the cell left to cel instead of always A1:
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
cel.Value = "=VLOOKUP(A" & cel.Row & ",H:I,2,0)"
End If
Next cel
End Sub
The code doesnt look like it's supposed to change values in 'A1'. The loop is over cells in B1:B20, so only cells in B1:B20 can change. Maybe you are not getting any changes expected because your if condition is never true?
I would suggest using the Immediate Window to check if the if condition is ever true with "Debug.print. Also better to use R1C1 references like this:
Sub AddFormula()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("B1:B20")
For Each cel In SrchRng
If InStr(1, cel.Value, "Yes") > 0 Then
Debug.Print "Was true"
cel.FormulaR1C1 = "=VLOOKUP(RC[-1],C[6]:C[7],2,0)"
End If
Next cel
End Sub
I am having an issue with with a section of my coding. I am trying to have a macro search row 1 for a term and if found then offset one cell and select over to column F. My issue is that I can only have it search for one term. I have to open up the VBA window and change the word if I want it to search for the second word. I would like it to search for either term and then offset based on the first occurrence in Row ("1:1"). Here is what I have. I need it to also look for the word "Mat".
Rows("1:1").Select
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("1:1")
For Each cel In SrchRng
If InStr(1, cel.Value, "Units per Assy") > 0 Then
cel.Offset(0, -1).Select
End If
Next cel
Range(ActiveCell.Offset(0, 0), Cells(Selection.Row, 6)).Select
Selection.EntireColumn.Select
Why not add another condition like below?
If InStr(1, cel.Value, "Units per Assy") > 0 Or InStr(1, cel.Value, "Mat") > 0 Then
Hard to understand why you use Range.Select() on many cells.
Anyways to search from a list of words you can adopt you code as below.
'Assume you search words are on a hidden sheet called 'Search Strings' from
'range A1:A5
Option Explicit
Public Sub highlight()
Dim SrchRng As Range, cel As Range
Dim searchStringsRange As Range, celSearch As Range
Set SrchRng = Range("1:1")
Set searchStringsRange = Sheets("Search Strings").Range("A1:A5")
'SrchRng.Select
For Each cel In SrchRng
For Each celSearch In searchStringsRange
If InStr(1, cel.Value, celSearch.Value) > 0 Then
cel.Offset(0, -1).Select
Exit For
End If
Next
Next cel
'Range(ActiveCell.Offset(0, 0), Cells(Selection.Row, 6)).Select
'Selection.EntireColumn.Select
End Sub
Hope above helps, it will select only one cell using offset.
Give me details on how you want to highlighting/selecting done
Thanks all. After sktneer's answer, I needed to add an exit for statement. works perfectly now. Below is the updated code.
Rows("1:1").Select
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("1:1")
For Each cel In SrchRng
If InStr(1, cel.Value, "Mat") > 0 Or InStr(1, cel.Value, "Units per Assy") > 0 Then
cel.Offset(0, -1).Select
Exit For
End If
Next cel
Range(ActiveCell.Offset(0, 0), Cells(Selection.Row, 6)).Select
I use this script to clear the contents of an adjacent cell if a certain text is found. However, I don't know how to change the range from the current region to strictly columns A to T. I tried ActiveSheet.Range("A:T").Select but that did not work.
Any help would be appreciated. Here is the code:
Sub Clear_Text()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = ActiveSheet.Range("A1").CurrentRegion
For Each rng2 In rng1
If rng2 Like "Error" Or _
rng2 Like "Mistake" Then rng2.Offset(, 1).ClearContents
Next
End Sub
looping through all cells of a given range could be time consuming
you could use Find() function to jump to relevant cells only:
Option Explicit
Sub Clear_Text()
With Range("T1", Cells(Rows.Count, "A").End(xlUp))
CheckAndClear .Cells, "Error"
CheckAndClear .Cells, "Mistake"
End With
End Sub
Sub CheckAndClear(rng As Range, strng As String)
Dim f As Range
Dim firstAddress As String
With rng
Set f = .Find(what:=strng, LookIn:=xlValues, lookat:=xlPart) '<--|with 'lookat:=xlPart' parameter specification makes you catch cell that contains the searched string
If Not f Is Nothing Then
firstAddress = f.Address
Do
f.Offset(, 1).ClearContents
Set f = .FindNext(f)
Loop While f.Address <> firstAddress
End If
End With
End Sub
Try it like this to limit search range to columns A:T:
Sub Clear_Text()
Dim cl As Range
For Each cl In ActiveSheet.Range("A1:T" & Range("A1").CurrentRegion.Rows.Count)
If cl Like "Error" Or cl Like "Mistake" Then
cl.Offset(0, 1).ClearContents
End If
Next
End Sub
I'm more than new at this, and I'm having trouble sorting out For...Next loops.
I want to track to two text variables in two columns, so that when both variables are found in a row text is added to that row in a different column.
This is what I have so far:
Sub AB()
Dim Rng1 As Range
Dim Rng2 As Range
Set Rng1 = Range("B1:B100")
Set Rng2 = Range("A1:A100")
For Each cel In Rng1
If InStr(1, cel.Value, "A") > 0 Then
For Each cel In Rng2
If InStr(1, cel.Value, "B") > 0 Then
cel.Offset(0, 5).Value = "AB"
End If
Next
End If
Next cel
End Sub
You might even be able to just do this?
Sub AB()
With ActiveSheet
For I = 1 To 100
If InStr(1, .Cells(I, 2), "A") > 0 And InStr(1, .Cells(I, 1), "B") > 0 Then
.Cells(I, 6).Value = "AB" 'i think offset 5 is column F?
End If
Next
End With
End Sub
Appreciate you have an answer now, but here's a different method using Find. Always good to know several ways to do something.
Sub AB()
Dim rng As Range
Dim itemaddress As String
With Columns(1)
Set rng = .Find("A", searchorder:=xlByRows, lookat:=xlWhole)
If Not rng Is Nothing Then
itemaddress = rng.Address
Do
If rng.Offset(0, 1) = "B" Then
rng.Offset(0, 2).Value = "AB"
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And itemaddress <> rng.Address
End If
End With
End Sub
You're using `cel' to step through each loop - the inner loop will get confused.
Along the vein of #findwindow answer (appeared as I was typing this). Loop just once and when a match is found check the cell next to it.
Sub AB()
Dim Rng1 As Range
Dim Rng2 As Range
Dim cel1 As Range
'Be specific about which sheet your ranges are on.
With ThisWorkbook.Worksheets("Sheet1")
Set Rng1 = .Range("B1:B100")
Set Rng2 = .Range("A1:A100")
End With
For Each cel1 In Rng1
'Check each value in column B.
If InStr(1, cel1.Value, "A") > 0 Then
'If a match is found, check the value next to it.
If InStr(1, cel1.Offset(, -1), "B") > 0 Then
cel1.Offset(, 4).Value = "AB"
End If
End If
Next cel1
End Sub