Excel VBA - if/then statement - Identifying cells with a dash - vba

I am trying to write a VBA line where if cell A1 contains a dash anywhere in the cell, then B1 will say "Blue". If there is no dash, then B1 would say "Red".
I have the following code written, but it's not working and I'm not sure if I'm doing the "like" part correctly:
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=" - ",""Blue"",""Red"")"
Thank you for any help you can provide! I've done so much searching, but have been unable to find any examples that didn't include specific numbers or text.

You can also use
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(FIND(""-"",RC[-1])),""Blue"",""Red"")"

Or a one-liner:
ActiveCell.FormulaR1C1 = "=IF(ISERROR(FIND(""-"",RC[-1])),""Red"",""Blue"")"

You could do it with a simple VBA script like this:
Sub Test()
Dim sh1 As Worksheet
Set sh1 = Sheets("Sheet1")
Application.ScreenUpdating = False
For x = 1 To sh1.Cells(rows.Count, "A").End(xlUp).Row
If InStr(1, sh1.Range("A" & x).Value, UCase("-"), 1) > 0 Then sh1.Range("B" & x).Value= "Red"
If InStr(1, sh1.Range("A" & x).Value, UCase("-"), 1) < 0 Then sh1.Range("B" & x).Value = "Blue"
Next x
Application.ScreenUpdating = True
End Sub

I don't believe that put a formula in every "B" column cells it's a good pratice, Excel can take a long time to calculate.
Try this:
Sub Example()
mySheet.Cells(1, "B").Value = IIf(Not InStr(1, mySheet.Cells(1, "A"), Chr(45), vbTextCompare) = 0, "Blue", "Red")
End Sub
You can loop through every cell you want to put that condition using this code.
Functions:
IIf is equals to Excel Worksheet Function "IF".
InStr search a string in another string, you can pass a unique char as criterea. I used chr(45) because it returns a char according to the passed code, 45 references to Dash code.

The error, corrected (but not pointed out) in several of the other answers lies in changing your formula from
" - "
to
"" - ""
i.e. going from single double-quotes around your - to double double-quotes. The single quote is ending your string - you can even see that the - shows up in black text in your question instead of red text, therefore, it's not part of the string being inserted into ActiveCell.FormulaR1C1.

Related

Excel VBA Conditional Formatting AND-Function

UPDATE:
I try to use conditional formatting for the following case:
If a cell in column C (starting with C9) Tabelle3.Range(Tabelle3.Cells(9, 3), Tabelle3.Cells(lastcell, 3))
is not empty Cell <>""
AND
fullfills a criteria which is stated in Tabelle4 Cell B2 Tabelle4.Range("B2")
its Interior.Color should be changed to Cellclr and its Font.Color to Fontclr
Start Old Post:
I looked through various posts about conditional formatting but I couldn't find any, that is preciously solving my problem.
I want to apply conditional formatting to a Excel workbook which will be constantly extanded. Therefore, I wrote the following code:
Sub ConForm()
Dim lastcell As Long
Dim Cellclr As Long
Dim Fontclr As Long
lastcell = Tabelle3.Range("A1048576").End(xlUp).Row
Cellclr = RGB(232, 245, 246)
Fontclr = RGB(26, 155, 167)
Set C = Tabelle3.Range(Tabelle3.Cells(9, 3), Tabelle3.Cells(lastcell, 3))
With C.FormatConditions.Add( _
Type:=xlExpression, _
Formula1:="=AND($C9<>"""";"$C9.Value <= Tabelle4.Range(""B2"").Value)")
.Interior.Color = Cellclr
.Font.Color = Fontclr
End With
End Sub
If I just use the following range and formula:
Range("C9")
Formula1:="=C9<>""""")
the code works out for Cell C9. However, as already mentioned, it should be this Formula
=AND($C9<>"""";"$C9.Value <= Tabelle4.Range(""B2"").Value
be applied for the range
Tabelle3.Range(Tabelle3.Cells(9, 3), Tabelle3.Cells(lastcell, 3))
Does someone know where I made a mistake/mistakes and how to solve this issue?
First, check the colours on your formatting to see what's a string and what's not - you have a mysterious extra " in the middle of your formula, which will prevent the code from compiling in the first place. You have also tried to put VBA code (Tabelle4.Range("B2").Value) into an Excel formula, which won't work.
If you want to fix the value of Tabelle4.Range("B2").Value when the macro is run, you can change
Formula1:="=AND($C9<>"""";"$C9.Value <= Tabelle4.Range(""B2"").Value)")
to
Formula1:="=AND($C9<>"""";$C9<=" & Tabelle4.Range("B2").Value & ")")
You need to concatenate the strings and values correctly.
Example:
MyVariable = "ccc"
result = "aaa" & "bbb" & MyVariable & "AnotherString"
'result is "aaabbbcccAnotherString"
I'm not sure what you tried but probably you meant something like
Formula1:="=AND($C9<>"""";" & Range("$C9").Value <= Tabelle4.Range("B2").Value & ")")
Or more likely something like
Formula1:="=AND($C9<>"""";$C9<=Tabelle4!B2)")
Update:
Formula1:="=AND($C9<>"""";$C9<=" & Tabelle4.Range("B2").Value & ")")

How to add a Formula To Cell using VBA [duplicate]

This question already has answers here:
How do I put double quotes in a string in vba?
(5 answers)
Closed 1 year ago.
I am attempting to write some VBA which will add header text to 3 cells then fill a formula all the way down to the last row. I have written the below, which writes the headers no problems, but when it get's to my first .Formula it throws a
Application Defined or Object Defined error
What needs to be altered so that this macro will execute successfully? (The formulas were pulled directly from the formula in the cell, so I know they are valid formulas at least on the "front-end")
Function Gre()
Range("E2").Select
ActiveCell.FormulaR1C1 = "Under"
Range("F2").Select
ActiveCell.FormulaR1C1 = "Over"
Range("G2").Select
ActiveCell.FormulaR1C1 = "Result"
With Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2<B2,B2-C2,"")"
End With
With Range("F2:F" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(C2>B2,C2-B2,0)"
End With
With Range("G2:G" & Cells(Rows.Count, "C").End(xlUp).Row)
.Formula = "=IF(F2>0,'Issue',"")"
End With
End Function
The problem is likely that you are escaping the quotes with the formula.
What you need is:
.Formula = "=IF(C2>B2,B2-C2,"""")"
for the first one, for example. The other quotes need to be doubled as well.
As a side-note, it would also be best to specify the sheet you are working on with something like:
Dim ws as worksheet
Set ws = Sheets("mySheet")
ws.Range("E2").FormulaR1C1 = "Under"
etc.
If you don't do this, you can sometimes have errors happen while running the code.
As suggested by OpiesDad, to minimize ambiguity, avoid ActiveCell and the like.
Using Select will also slow down performance a lot compared to assigning to cells directly.
I'm pretty sure you need to escape quotes in Excel formulas inside of VBA by doubling the quotes, so a normal empty string becomes """". You also have Issue in single quotes in a formula, which I'm pretty sure will error in Excel; that should be in escaped double quotes as well.
I'm having a hard time figuring out what Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) actually does, but it sounds like you want to select E2 to the last used row of the sheet. Avoid Rows.Count or just generally referring to the rows of a sheet, as that will go to row 10^31. Use Worksheet.UsedRange to get the range from the first row and column with content to the last row and column with content. This also includes empty strings and can be a bit tricky sometimes, but is usually better than dealing with thousands of extra rows.
Also,
You don't need to use With if your only enclosing one statement, although it won't cause any problems.
I would not mix use of Range.Formula and Range.FormulaR1C1 unless you have a reason to.
Function Gre()
Dim ws as Worksheet
Set ws = ActiveSheet
Dim used as Range
Set used = ws.UsedRange
Dim lastRow as Integer
lastRow = used.Row + used.Rows.Count - 1
ws.Range("E2").Formula = "Under"
ws.Range("F2").Formula = "Over"
ws.Range("G2").Formula = "Result"
ws.Range("E2:E" & lastRow).Formula = "IF(C2<B2, C2-B2, """")"
ws.Range("F2:F" & lastRow).Formula = "IF(C2<B2, C2-B2, 0)"
ws.Range("G2:G" & lastRow).Formula = "IF(F2>0, ""Issue"", """")"
End Function
The first issue is the selecting of cells. This requires the macro to select the cell, then determine the cell address. If you need to actually select a cell, use Application.ScreenUpdating = False. Then the macro doesn't have to show the cursor selection of a cell. Dropping the select and incorporating the range into the formula assignment code line like below will gain some speed/efficiency.
Range("E2").FormulaR1C1 = "Under"
Range("E2:E" & Cells(Rows.Count, "C").End(xlUp).Row) is the code version of selecting the last cell in a blank column (row 1048576), then using the keystroke of ctrl and the up key to determine the lowest/last used cell. This gets you a row count of 1 every time since the column is blank. Since you're looking for the last row. It may be faster to count down from the top. My favorite method for this is a loop. Increment a variable within a loop, while looking for the last row. Then, the variable can be used instead of your bottom up strategy.
t = 0
Do Until Range("C2").Offset(t, 0).Value = ""
t = t + 1
Loop
With Range("E2:E" & t)
.Formula = "=IF(C2<B2,B2-C2,"""")"
End With`
Just like TSQL, quote characters need their own quote characters.
.Formula = "=IF(C2<B2,B2-C2,"""")"
The Range Fillup VBA function can be utilized in this case to fill all cells from the bottom with a common formula, accounting for Excel Formula Reference Relativity. The code below starts with the range that we got from the loop counter. Next, we set a variable equal to the total rows in Excel minus the row corresponding to the counter row. Then, we resize the original region by the necessary rows and use the FillDown function to copy the first formula down.
Here's the resulting code. This will fill the range starting from the last row in Excel.
Sub Gre()
Range("E2").FormulaR1C1 = "Under"
Range("F2").FormulaR1C1 = "Over"
Range("G2").FormulaR1C1 = "Result"
Do While Range("e2").Offset(t, 0).Value <> ""
t = t + 1
Loop
Range("E2").Offset(t, 0).Formula = "=IF(C2<B2,B2-C2,"""")"
r1 = Range("e2").EntireColumn.Rows.Count
r2 = Range("E2").Offset(t, 0).Row
Range("E2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("F2").Offset(t, 0).Formula = "=IF(C2>B2,C2-B2,0)"
Range("F2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
Range("G2").Offset(t, 0).Formula = "=IF(F2>0,""Issue"","""")"
Range("G2").Offset(t, 0).Resize(r1 - r2, 1).FillDown
End Sub
As well as using double quotes you may need to use 0 in the first two formula otherwise they may evaluate to empty strings. This may give unexpected results for the last formula i.e. incorrectly return "Issue".
If you do not have blank columns between your data and the 3 new columns you can use CurrentRegion to determine the number of rows:
Range("E2:E" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2'<'B2,B2-C2,0)"
Range("F2:F" & Cells.CurrentRegion.Rows.Count).Formula = "=if(C2>B2,C2-B2,0)"
Range("G2:G" & Cells.CurrentRegion.Rows.Count).Formula = if(F2>0,""Issue"","""")"
Please try the following sample hope it will help you to wright formula in VBA
Sub NewEntry()
Dim last_row As Integer
Dim sht1 As Worksheet
Dim StockName As String
Set sht1 = Worksheets("FNO MW")
last_row = Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'MsgBox last_row
StockName = sht1.Cells(last_row, 1).Value
sht1.Cells(last_row, 1).Formula = "=RTD(""pi.rtdserver"", ,"" " & StockName & " "", ""TradingSymbol"")"
End Sub

VBA search and copy

I'm automating an update I have to do and part of the macro I want to write needs specific text from what gets populated.
I have the following types of text in the same column for hundreds of rows:
ScreenRecording^naushi02^procr^10035
procr^10635^ScreenRecording^misby01
ScreenRecording^liw03^procr^10046
I've bold the text I need. I want to either replace the whole text with just what I need or place what I need in the next column, same row.
I had wrote something which worked for 60 or so lines before I realised that there are variations in the format. For the main, it's all the same which is why I didn't realise at first and I've spent a lot of wasted time writing something that is now useless... so I'm asking for expert help please.
Once I've got what I need from the first row, I need to move down until the last entry repeating.
I had some code which obviously didn't work fully.
I have thought about using the text 'ScreenRecording' in a search along with the special character which I can't find on my keyboard and then trying to copy all text from that point upto and including the 2nd numerical character. I don't know how to do this, if it would work or even if it's a good idea but because I've spent so much time trying to figure it out, I need some help please.
Thanks in advance
If you always want to return the value after the word 'ScreenRecording`, you can use the following function to do so.
Include it in a SubRoutine to replace in place if needed:
Function SplitScreenRecording(sInput As String) As String
Dim a As Variant
Const SDELIM As String = "^"
Const LOOKUP_VAL As String = "ScreenRecording"
a = Split(sInput, SDELIM)
If IsError(Application.Match(LOOKUP_VAL, a, 0)) Then
SplitScreenRecording = CVErr(2042)
Else
SplitScreenRecording = a(Application.Match(LOOKUP_VAL, a, 0))
End If
End Function
Sub ReplaceInPlace()
Dim rReplace As Range
Dim rng As Range
Set rReplace = Range("A1:A3")
For Each rng In rReplace
rng.Value = SplitScreenRecording(rng.Value)
Next rng
End Sub
if you want to replace:
Sub main2()
Dim key As String
Dim replacementStrng As String
key = "ScreenRecording"
replacementStrng = "AAA"
With Worksheets("mysheet01").columns("A") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
.Replace what:=key & "^*^", replacement:=key & "^" & replacementStrng & " ^ ", LookAt:=xlPart
.Replace what:="^" & key & "^*", replacement:="^" & key & "^" & replacementStrng, LookAt:=xlPart
End With
End Sub
while if you want to place what you need in the next column:
Sub main()
Dim myRng As Range
Set myRng = GetRange(Worksheets("mysheet01").columns("A"), "ScreenRecording^") '<--| change "mysheet01" and "A" to your actual sheet name and column to filter
myRng.Offset(, 1) = "value that I need to place in next row" '<--| change the right part of the assignment to what you need
End Sub
Function GetRange(rng As Range, key As String) As Range
With rng
.AutoFilter Field:=1, Criteria1:="*" & key & "*" '<--| apply current filtering
If Application.WorksheetFunction.Subtotal(103, .Cells) > 0 Then '<--| if there are visible cells other than the "header" one
With .SpecialCells(xlCellTypeConstants)
If InStr(.SpecialCells(xlCellTypeVisible).Cells(1, 1), key & "^") > 0 Then
Set GetRange = .SpecialCells(xlCellTypeVisible) '<--|select all visible cells
Else
Set GetRange = .Resize(.Parent.Cells(.Parent.Rows.Count, .Column).End(xlUp).row - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<--|select visible rows other than the first ("headers") one
End If
End With
End If
.Parent.AutoFilterMode = False '<--| remove drop-down arrows
End With
End Function

VBA Right-Function returning wrong data type

I have written a very simple code which returns the last 6 characters of every active cell within a range.
The code works pretty good until it finds a particular cell in which the characters to be returned should be: "MARC01". Unfortunately it returns a date type character (01.Mrz).
By using the normal excel formula it works fine, that is why I would expect it to work with a Macro as well.
Here you can see my code which takes the strings from column "A" and enters it in column "B":
Range("B12").Activate
Do
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Value), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
Excel likes to change anything that looks like a possible date to a date. To force this not to happen put a "'" in front of the formula.
ActiveCell.Value = "'" & Right((ActiveCell.Offset(0, -1).value), 6)
This will force it to stay text. The down side to this is, if it is a number it will be saved as text.
Excel likes to try to interpret certain data, rather than just leaving it as is. It especially does that with strings that look like dates, and with numeric entries.
Two ways to workaround are
Put the text prefix character in front of your string. This is usually a single quote. (see Scott's answer for code)
Format the cell as Text before you place the value there.
Sub foo()
Range("B12").Activate
Do
ActiveCell.NumberFormat = "#"
ActiveCell.Value = Right((ActiveCell.Offset(0, -1).Formula), 6)
ActiveCell.Offset(1, 0).Activate
Loop Until ActiveCell.Offset(0, -1).Value = 0
End Sub
With this simple goal, I don't know why you need VBA looping.
You can just mass set the formular1c1 to =RIGHT(RC[-1],6).
Option Explicit
Sub Right6()
Const R6LeftCol = "=RIGHT(RC[-1],6)"
Dim oRng As Range, lRow As Long
lRow = Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = Range("B12")
Range(oRng, Cells(lRow, "B")).FormulaR1C1 = R6LeftCol
Set oRng = Nothing
End Sub

VBA countif statement only returns 0

I'm working on a macro that is supposed to count the number of times the term "GM" appears in a column. I decided to use a countif statement, as I have before and it worked well. However, for some reason when I run my code it outputs 0 every time, which definitely is not correct. I've run this same code with other columns and strings and it has worked fine, but for some reason if I search this certain column for the term "GM" it fails. The only thing I can think of is maybe countif only works if the string you're searching for is the only string in a cell, because in all cases where this is true the code works fine. In this particular case the string I'm looking for is not the only string in the cell and the code is failing. I've tried to find more info on whether or not this is true but I can't find anything online. Here's the code if anyone would like to take a look:
Function OemRequest() As Long
Sheets("CS-CRM Raw Data").Select
Sheets("CS-CRM Raw Data").Unprotect
Dim oem As Long
Dim LastRow As Long
Dim LastColumn As Long
'Determines size of table in document
LastRow = Range("A" & Rows.Count).End(xlUp).row
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
oem = Application.WorksheetFunction.CountIf(Range(2 & "2:" & 2 & LastRow), "gm")
OemRequest = oem
End Function
You are correct that the COUNTIF as written will only match cells where the whole content is "gm". The criteria in the COUNTIF function will also accept wildcards, so to match on cells that contain "gm" do:
.CountIf(Range(2 & "2:" & 2 & LastRow), "*gm*")
Update
As you noted there is also an issue with your Range call. As it is, the expression inside the parens will evaluate to "22:2<LastRow>" (where <LastRow> is the value of the LastRow variable).
The 2's in there should be a variable containing the column name you're interested in. Something like:
Dim col as String
col = "B"
... Range(col & "2:" & col & LastRow) ...
This will evaluate to "B2:B<LastRow>", which is what you want.
Another possibility:
oem = WorksheetFunction.CountIf(Columns(LastColumn).Cells(2).Resize(rowsize:=LastRow - 1), "gm")
This will count cells containing "gm" (use wilcards if needed) in the LAST column of the table, except the one in the first row. (It assumes the table upper left corner is in cell "A1")
Of course you can create a variable if you would like to count any other column:
Dim lngCol as Long
lngCol = ...
oem = WorksheetFunction.CountIf(Columns(lngCol).Cells(2).Resize(rowsize:=LastRow - 1), "gm")
I think in this way
Sub Main()
Application.ScreenUpdating = 0
Dim Count As Double
Range("C1").Activate 'Firs row in the column
Do While ActiveCell.Value <> ""
If InStr(ActiveCell.Value, "MyText") Then
Count = Count + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = 1
End Sub
This will work, only if the data cell is not empty, if there is an empty space in middle of the worksheet, do this:
Sub Main()
Application.ScreenUpdating = 0
Dim Count As Double
Range("C1").Activate
Do While ActiveCell.Row <> Rows.Count ' This wil evaluate all the rows in the 'C' Column
If InStr(ActiveCell.Value, "MyText") Then
Count = Count + 1
End If
ActiveCell.Offset(1, 0).Activate
Loop
Application.ScreenUpdating = 1
End Sub
Hope it's work for you.