VBA add Formula to cells containing specific text - vba

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

Related

Insert HLOOKUP formula if cell contains text

This is how my spreadsheet looks like:
enter image description here
I would like to insert a HLOOKUP formula to the cell immediate right of 58DV if the cell contains 58DV. If there is no data, nothing needs to be done. I'm still quite new to VBA so I'm not sure how can i work with formulas in VBA. Thanks
Sub sitelookup()
With Application
.ScreenUpdating = False
End With
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("C4:C1299")
For Each cel In SrchRng
If cel > 0 Then
cel.Offset(0,1).value = Application.WorksheetFunction.HLOOKUP(F4,'Raw G'!2:5,2,0)
End If
Next cel
End Sub
Try,
with worksheets("sheet1")
Set SrchRng = .Range(.cells(4, "B"), .cells(rows.count, "B").end(xlup))
For Each cel In SrchRng
If cel.value2 = "58DV" Then
'to put the formula's value into the neighboring cell
cel.Offset(0, 1).value = _
Application.HLOOKUP(.cells(cel.row, "F"), worksheets("Raw G").range("2:5"), 2, 0)
'to put the formula into the neighboring cell
'cel.Offset(0, 1).formula = _
"=HLOOKUP(F" & cel.row & ",'Raw G'!2:5, 2, 0)"
End If
Next cel
end with

Unable to create a loop using usedrange property

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

Search Range looking for multiple terms then proceed

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

VBA: Cells Starting with "=" Causing Problems in my Move Macro

I currently have some code that finds cells not in the first column and moves them over. I'm facing a problem with cells that start with "=". Can you guys think of any work-arounds to solve this problem. Thanks in Advance.
Sub Move()
Dim cel As Range, rng As Range
Dim wk As Worksheet
Set wk = ActiveWorkbook.ActiveSheet
Set rng = wk.UsedRange
For Each cel In rng
If cel.Value <> "" And cel.Column <> 1 Then
wk.Cells(cel.Row, 1) = cel.Value
cel.Value = ""
End If
Next cel
End Sub
Either every time in your For each loop
If Cstr(cel.Value) <> "" And ... 'you need to do that for every cel.Value occurencies
Or declare a variable at the beginning
Dim StringInCell as String
For Each cel In rng
StringInCell=Cstr(cel.Value)
If StringInCell...
You may try .Text property as well (though I haven't had luck using that ever, I rather to use CStr).
This may work as well if the parsed data is throwing an error exception or something:
...
wk.Cells(cel.Row, 1).NumberFormat = "#"
wk.Cells(cel.Row, 1) = Cstr(cel.Value) 'related to the option chosen from above
Try this
Sub Move()
Dim cel As Range, rng As Range
Dim wk As Worksheet
Set wk = ActiveWorkbook.ActiveSheet
Set rng = wk.UsedRange
For Each cel In rng
If cel.HasFormula Then
wk.Cells(cel.Row, 1).Formula = cel.Formula
cel.ClearContents
Else
If cel.Value <> "" And cel.Column <> 1 Then
With wk.Cells(cel.Row, 1)
.NumberFormat = "#" '<<edit: added formatting
.Value = cel.Value
End with
cel.Value = ""
End If
End If
Next cel
End Sub
If you have cells that begin with =, but are not to be treated as formulas, but rather as Text, then using Sgdva's alternative suggestion:
Sub Move()
Dim cel As Range, rng As Range
Dim wk As Worksheet
Set wk = ActiveWorkbook.ActiveSheet
Set rng = wk.UsedRange
For Each cel In rng
If cel.Text <> "" And cel.Column <> 1 Then
wk.Cells(cel.Row, 1) = cel.Text
cel.Value = ""
End If
Next cel
End Sub
EDIT#1:
This version should "de-formularise" a cell before moving it to column 1:
Sub Move2()
Dim cel As Range, rng As Range
Dim wk As Worksheet, s As String
Set wk = ActiveWorkbook.ActiveSheet
Set rng = wk.UsedRange
For Each cel In rng
s = cel.Text
If s <> "" And cel.Column <> 1 Then
wk.Cells(cel.Row, 1).Value = s
cel.Value = ""
End If
Next cel
End Sub

VBA search in two ranges

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