Named range in conditional formatting formula - vba

I have code like below. And I would like to set named ranges (cells) instead of ranges (cells) H$7 and $G$7. Because if for example I add new column before these cells and recover macro with this code it does not work correctly. Have you got any idea? Thanks in advance
With Range(SomeRange).FormatConditions _
.Add(xlExpression, xlFormula, "=((H$7<=$G$7)*((H$7+7)>$G$7))")
With .Interior
.Color = RGB(197, 217, 241)
End With
End With

Just type the name of a named range in the formula, nothing special as long as the named range exists. If I name H7 "B" and G7 "A" then this works for me...
Sub Test()
'Range
Dim R As Range
Set R = Range("A1")
R.FormatConditions.Delete
'Formula
Dim F As String
F = "=((B<=A)*((B+7)>A))"
'Condition
Dim Cond As FormatCondition
Set Cond = R.FormatConditions.Add(xlExpression, xlFormula, F)
Cond.Interior
Cond.Color = RGB(197, 217, 241)
End Sub
Note though, with the formula argument of 'FormatConditions.Add', everything within the double quotes gets evaluated exactly as if typed within a cell. The argument is passed as a string and interpreted as a literal string value. So you can test your formula string by copying and pasting it to a cell and it should work the same (return 1 or 0), modify it in the cell, and copy and past back.
You don't have to create/set the names problematically, but if you want to, then I'd probably use the workbooks collection unless you repeat the same name on multiple sheets, then use the worksheet collection.
About named ranges...
The Object (Name)
The Collection (Names)
Setting Referencing

Try getting the address of the named ranges and concatenating them in your formula string.
Eg.
Adr1= range("namedrange1"). Address
Adr2= range("namedrange2"). Address
With Range(SomeRange).FormatConditions _
.Add(xlExpression, xlFormula, "=((" & adr1 & "<=" & ad2 & ")*((" & adr1 & "+7)>" & adr2 & "))")

Related

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

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.

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 & ")")

Another >> Unable to set the FormulaArray property of the range class

I've researched as many of the "Unable to set the FormulaArray property of the range class" issues here and in other sites to troubleshoot a FormulaArray operation I'm trying to carry out in a table of data.
I've respected the 255 character limit in my formula taking into account R1C1, I've tried to insert the formula as a text string first. I've tried quite a few things.
Now I'm thinking my issue is with the fact that I'm trying to insert my formula only into blank cells because if I simplify my formula to only be =1+1 I still get the error. If I change .FormulaArray to .Formula to simply enter a standard formula I also get the same error. Is this operation not possible with blank cells?
The error occurs at the .FormulaArray = myFormula1 step.
To confirm, the formula by itself works (pasted further below) when entered into cells manually.
Sub ArrayMacro()
Dim myFormula1 As String
Dim myFormula2 As String
Dim myFormula3 As String
Dim myFormula4 As String
myFormula1 = "=IF(COUNTIFS(MLBtransactions!$D:$D,A$1,MLBtransactions!$A:$A,""<=""&$C2)>0,IF(INDEX(MLB," & "X_X_X)"
myFormula2 = "transactions!$A:$E,MATCH(1,(MLBtransactions!$D:$D=A$1)*(MLBtransactions!$A:$A<=$C2),0),," & "Y_Y_Y)"
myFormula3 = "5)=$A2,""DNP/SUS/MIN"",""with "" & INDEX(MLBtransactions!$A:$E,MATCH(A$1,MLBtransactions," & "Z_Z_Z)"
myFormula4 = "!$D:$D,0),5)),IF(COUNTIFS(MLBstats!$B:$B,A$1,MLBstats!$A:$A,$A2)=1,""DNP/SUS/MIN"",""LEAVE BLANK""))"
Sheets("Sheet1").Select
With Range("E2:AZ140").SpecialCells(4)
.FormulaArray = myFormula1
.Replace ",X_X_X)", myFormula2
.Replace ",Y_Y_Y)", myFormula3
.Replace ",Z_Z_Z)", myFormula4
End With
End Sub
Question update. Using With Range("E2:AZ140").SpecialCells(xlCellTypeBlanks) instead of With Range("E2:AZ140").SpecialCells(4) also ends with the same error.
Here is the full formula being used
=IF(COUNTIFS(MLBtransactions!$D:$D,A$1,MLBtransactions!$A:$A,"<="&$C2)>0,IF(INDEX(MLBtransactions!$A:$E,MATCH(1,(MLBtransactions!$D:$D=A$1)*(MLBtransactions!$A:$A<=$C2),0),5)=$A2,"DNP/SUS/MIN","with " & INDEX(MLBtransactions!$A:$E,MATCH(A$1,MLBtransactions!$D:$D,0),5)),IF(COUNTIFS(MLBstats!$B:$B,A$1,MLBstats!$A:$A,$A2)=1,"DNP/SUS/MIN","LEAVE BLANK"))
Testing with a simplified code (example below) led to the realization as YowE3K points out that myFormula1 needs to be valid in order for the procedure to work.
Sub ArrayMacro()
Dim myFormula1 As String
Dim myFormula2 As String
myFormula1 = "=1+1" & "+2+2"
myFormula2 = "+1+1"
Sheets("Sheet1").Select
With Range("h14:h16").SpecialCells(xlCellTypeBlanks)
MsgBox .Address
.FormulaArray = myFormula1
.Replace "+2+2)", myFormula2
End With
End Sub
When you set a formula using FormulaArray = ..., it needs to be a valid formula. (I think after each Replace the formula needs to continue being valid too, but I haven't tested that. Edit: No, if the Replace would create an invalid formula, it just doesn't process it - but it doesn't crash.)
Your problems all seem to stem from the use of invalid formulas in your myFormula1 variable.
I suggest you use the following:
Sub ArrayMacro()
Dim myFormula1 As String
Dim myFormula2 As String
Dim myFormula3 As String
Dim myFormula4 As String
myFormula1 = "=IF(COUNTIFS(MLBtransactions!$D:$D,A$1,MLBtransactions!$A:$A,""<=""&$C2)>0,IF(1232=$A2,""DNP/SUS/MIN"",""with ""&1233),1234)"
myFormula2 = "INDEX(MLBtransactions!$A:$E,MATCH(1,(MLBtransactions!$D:$D=A$1)*(MLBtransactions!$A:$A<=$C2),0),5)"
myFormula3 = "INDEX(MLBtransactions!$A:$E,MATCH(A$1,MLBtransactions!$D:$D,0),5)"
myFormula4 = "IF(COUNTIFS(MLBstats!$B:$B,A$1,MLBstats!$A:$A,$A2)=1,""DNP/SUS/MIN"",""LEAVE BLANK"")"
'Insert the formula
With Sheets("Sheet1").Range("E2:AZ140").SpecialCells(xlCellTypeBlanks)
.FormulaArray = myFormula1
.Replace "1232", myFormula2
.Replace "1233", myFormula3
.Replace "1234", myFormula4
End With
End Sub
Setting .FormulaArray to a range of cells in VBA is the same as pressing CTRL+SHIFT+ENTER while the entire range is selected. This is used when a single formula is returning an array of results and you want to display that array in the range of selected cells. This requires a contiguous range of cells to display the array. Trying to set .FormulaArray on a non-contiguous range of cells will fail, regardless of whether the formula is good or not.
I think you're trying to create an Array Formula that returns a single result after performing analysis on arrays; and you want this formula used in all blank cells.
In Excel, you would need to array-enter the formula into a single cell and then copy the formula into other cells.
Similarly, you need to do it in 2 steps in VBA. You need to first set the .FormulaArray for just one cell. This will also confirm that the formula is being constructed correctly in VBA. You can then copy that cell to all blank cells, using PasteSpecial if you only want to copy the formula.
Alternatively, you could loop through all blank cells setting the .FormulaArray individually, e.g.:
Dim raCell As Range
For Each raCell In Range("E2:AZ140")
If IsEmpty(raCell) Then raCell.FormulaArray = ...
Next
However, as you have dynamic references, you would need to construct the FormulaArray carefully to correctly determine the formula required based on the .Row and .Column of the current raCell.
Copy and paste would be safer if you have an "achor" point. Somewhere you know you can always enter the exact same formula and get the correct result when copied and pasted to all other cells.

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

Use User-defined range as input for cell parsing

I'm writing a macro in Excel 2010 in order to remove line breaks in multiple cells of a column. This cells need to be selected by the user. Following this previous post I was able to create an InputBox to let the user select the range but now, I am unable to process the data within the selection.
My previous code without the selection range parsed an entire column with a regexp to find a pattern in the string within the cells and change its contents.
I did this with a For i To Rows.Count block of code like this:
For i = 1 To Rows.Count
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i,5).Value=objRegExp.Replace(varString, "$1 ")
End If
Next i
Now I want to replace the static column so I can process only the user range.
In order to achieve that I tried this:
Set selection = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If selection Is Nothing Then
Exit Sub
End If
Set RowsNumber = selection.CurrentRegion -> This line gives me an error: "Object required"
Set RowsNumber = RowsNumber.Rows.Count
For i = 1 To RowsNumber
If Not IsEmpty(Cells(i, 5).Value) Then
varString = Sheets(ActiveSheet.Name).Cells(i, 5).Text
Sheets(ActiveSheet.Name).Cells(i, 5).Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next i
How can I access the cells in the range returned by the InputBox?
I also tried changing RowsNumber with selection.Rows.Count but that way, although it doesn't gives an error, the cells used have blank string within them when I run the debugger. I think this is because I try to access row = 5 when the range could be less, i.e 3 if user just selects 3 cells.
I tried a For Each Next loop but then again, I know not how to access the cells withing the selection range.
You can iterate through the cells of a range by using For Each loop.
Below is your code modified. I have changed the name of variable Selection to rng, because Selection is Excel library built-in function and this name should be avoided.
Sub x()
Dim rng As Excel.Range
Dim cell As Excel.Range
Set rng = Application.InputBox(Prompt:= _
"Please select a range to apply the remove break lines procedure.", _
Title:="Remove Line Breaks", Type:=8)
If rng Is Nothing Then
Exit Sub
End If
For Each cell In rng.Cells
If Not IsEmpty(cell.Value) Then
varString = cell.Text
cell.Value = objRegExp.Replace(varString, "$1 ") 'Replace pattern found with regular expression in the same line
End If
Next cell
End Sub