I have the following code:
i = i + 1
StrSearchCriteria = "=($W1=" & Chr(34) & "ETF" & Chr(34) & ")"
With .Range("A:A").FormatConditions
.Add Type:=2, Formula1:=StrSearchCriteria
With .Item(i)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(225, 225, 0)
End With
.StopIfTrue = False
End With
End With
This does not set the format conditions. The rule is there and the range, criteria are correct, but the format conditions are "No Format Set".
HOWEVER.... if I change
With .Range("A:A").FormatConditions
to
With .Range("E:E").FormatConditions
It works...
"B:B", "C:C", "D:D" all fail with the same issue.
Using "E:E" (and I also tried "F:F" which worked), I can then open the workbook and manually change the range to "A:A", "B:B", "C:C" or "D:D" and it works.
I then tried "A:E", which also worked. It appears that if I use any part of column E through W (last column) it works, but if I don't include anything from E and following it fails.
Totally confused here. Any ideas?
Is there a merged cell range in A:D?
I believe #mer_curius hit on the issue - merged cells.
So, as a work around, since I only want A:A to have the coloring and I need to set the condition to A:E, I follow that rule with setting a rule with the same criteria and no-fill B:E.
The code that works looks like this:
i = 1
StrSearchCriteria = "=($W1=" & Chr(34) & "ETF" & Chr(34) & ")"
strRange = "A:E"
With .Range(strRange).FormatConditions
.Add Type:=2, Formula1:=StrSearchCriteria
With .Item(i)
.SetFirstPriority
With .Interior
.PatternColorIndex = xlAutomatic
.Color = RGB(225, 225, 0)
End With
.StopIfTrue = False
End With
End With
i = i + 1
StrSearchCriteria = "=($W1=" & Chr(34) & "ETF" & Chr(34) & ")"
strRange = "B:E"
With .Range(strRange).FormatConditions
.Add Type:=2, Formula1:=StrSearchCriteria
With .Item(i)
.SetFirstPriority
With .Interior
.Pattern = xlNone
End With
.StopIfTrue = False
End With
End With
Related
I want to format data in 2 columns in the same pattern. Each data column has its length based on upper boundary of result array. I initially formatted them both separately and it was working as intended, but I want to keep the code as lean as possible.
I tried the code below, but it created a range from 1st range to the 2nd instead of matching a sum of these ranges:
With statsWS
With Range(.Range("b2:c" & UBound(vGoals) + 1), _
.Range("e2:f" & UBound(vAssists) + 1))
With .Borders
.LineStyle = xlContinuous
.Color = rgbGrey
End With
End With
End With
something like this:
With statsWS.Range("b2:c" & (UBound(vGoals) + 1) & ",e2:f" & (UBound(vAssists) + 1)).Borders
.LineStyle = xlContinuous
.Color = rgbGrey
End With
You could use Chris Neilsen's suggestion:
With statsWS
With Union(.Range("B2:C" & UBound(vGoals) + 1), .Range("E2:F" & UBound(vAssists) + 1))
With .Borders
.LineStyle = xlContinuous
.Color = rgbGrey
End With
End With
End With
But if you want to keep your code lean then you could pass the ranges to another Subroutine to handle the formatting. Separating the business logic from the display:
Usage:
ApplyBorders .Range("B2:C" & UBound(vGoals) + 1), .Range("E2:F" & Bound(vAssists) + 1)
Code:
Sub ApplyBorders(ParamArray Ranges())
Dim x As Long
Dim r As Range
Set r = Ranges(0)
For x = 1 To UBound(Ranges())
Set r = Union(r, Ranges(x))
Next
With r.Borders
.LineStyle = xlContinuous
.Color = rgbGrey
End With
End Sub
Note: Because ApplyStandardBorders uses a ParamArray you can pass anywhere from 0 to 60 parameters to it (Only 29 in Excel 2003).
you can also use the Range("Address1,Address2") method to get the union of different ranges
With statsWS
With .Range(.Range("b2:c" & UBound(vGoals) + 1).Address & "," & .Range("e2:f" & UBound(vAssists) + 1).Address).Borders
.LineStyle = xlContinuous
.Color = rgbGrey
End With
End With
I am trying to conditionally format a range of cells based on the number in the column to each cell groupings' left. Basically, if in row 13, the gray column to the left of each cell grouping = 0, then I want the whole cell grouping to its right to turn green, if = 15, turn yellow, if = 25 turn red. Row 12 is what is happening with my code right now and row 13 is what I want it to look like. I can't seem to get the loop correct.
Sub Highlight3()
For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 4) = "Highlight" Then
For j = 1 To 15
Range(Cells(i, j * 4 + 2), Cells(i + 1, j * 4 + 4)).Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E$23 = 0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = rgbRed
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E$23= 15"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = rgbGold
End With
Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=$E$23 = 25"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Color = rgbGreen
End With
Next j
End If
Next i
End Sub
Avoid Select because it's slow and unyieldy. Just directly assign your Ranges to variables and work with those.
Sub Highlight3()
For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row Step 2
If Cells(i, 4) = "Highlight" Then
For j = 1 To 15
Dim r As Range
Set r = Range(Cells(i, j * 4 + 2), Cells(i + 1, j * 4 + 4))
Dim checkAddress As String
checkAddress = Cells(i, j * 4 + 1).Address
With r.FormatConditions
.Delete
.Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 0"
.Item(.Count).Interior.Color = rgbRed
.Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 15"
.Item(.Count).Interior.Color = rgbGold
.Add Type:=xlExpression, Formula1:="=" & checkAddress & " = 25"
.Item(.Count).Interior.Color = rgbGreen
End With
Next j
End If
Next i
End Sub
Things to notice:
No more ugly use of selection - get the Range r once and do all the tasks with its conditional formatting in one clean block.
No longer sets the new conditional formats to have first priority. Edit that back in if necessary, but I was guessing that it was just something that the Macro Recorder did.
Builds the formatting formula to check against the address directly left of the first cell. Make sure that the expression for checkAddress is what you'd expect, because I had to infer it from your picture and code. If that area with the value 0/15/25 is actually two merged cells (kinda looks like it is), then make sure this formula is for the upper cell, because that cell will be the one that actually holds the value.
Again, hard to tell from just a picture, but it looks like each of your "rows" is actually two cells high (based on your code, too). So you actually want to step through values of i by 2 at a time, not 1 at a time.
If any of the assumptions I've just listed about your table's formatting are wrong, let me know and I'll help iron out any remain kinks in the code.
This should do what you want and also be a bit faster:
Sub Highlight3()
Dim i As Long, j As Byte, myCols As Range, myRng As Range
Set myCols = Range("$B:$D")
For i = 1 To ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
If Cells(i, 4) = "Highlight" Then
If myRng Is Nothing Then
Set myRng = Intersect(Rows(i), myCols)
Else
Set myRng = Union(myRng, Intersect(Rows(i), myCols))
End If
i = i + 1 'skip the line after, because it will never have a value / merged cell
End If
Next
If myRng Is Nothing Then Exit Sub
For i = 4 To 60 Step 4
For j = 0 To 1
With myRng.Offset(j, i)
.Cells(1).Offset(-j).Activate
.FormatConditions.Delete 'if that does not interfer with other stuff, better use the next line
'If j = 0 Then myCols.Offset(, i).FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=0"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Interior.Color = rgbRed
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=15"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Interior.Color = rgbGold
.FormatConditions.Add Type:=xlExpression, Formula1:="=" & .Cells(1).Offset(-j, -1).Address(0) & "=25"
.FormatConditions(.FormatConditions.Count).SetFirstPriority
.FormatConditions(1).Interior.Color = rgbGreen
End With
Next
Next
End Sub
tested it locally and it worked... there may be issues which I can not know (better test it with a copy of your workbook).
The first part pushes all lines in a range which is used in the second part. This way, each pack of columns needs only 2 steps (no need to run EVERY line).
If you have any questions or problems with this code, just ask ;)
I'm trying to add conditional formatting to a range that checks cell X1 and if it doesn't match it applies the conditions.
If i apply it to one cell it works great. however i need it applied to each cell in a range.
code:
Function FindComment(rng As Range, strSearch As String) As Boolean
On Error GoTo err_h:
strSearch = LCase(strSearch)
If Len(strSearch) = 0 Then
FindComment = False
Exit Function
End If
If InStr(1, rng.Comment.Text, strSearch, vbTextCompare) > 0 Or InStr(1, rng.Text, strSearch, vbTextCompare) > 0 Then
FindComment = False
Exit Function
End If
FindComment = True
Exit Function
err_h:
FindComment = True
End Function
And to apply the conditional formatting:
Public Sub AddConditionalFormat(rng As Range)
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Address(, , xlA1) & ",$X$1)"
rng.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.ColorIndex = 2
End With
With rng.FormatConditions(1).Interior
.Pattern = xlGray75
.PatternThemeColor = xlThemeColorDark2
.PatternTintAndShade = 0
.ColorIndex = 2
.TintAndShade = 0
.PatternTintAndShade = 0
End With
rng.FormatConditions(1).StopIfTrue = False
End Sub
the range range("B6:GD9") are determined as rng.
currently if the results match it just blanks out all cells including the match.
anyone have an idea of how to easily fix? i'd prefer something that would not lag out the code by applying to each cell etc.
The Range.Address property defaults to absolute row and column references. You are looking for something like A1 but you are getting $A$1.
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Cells(1, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False, ReferenceStyle:=xlA1) & ", $X$1)"
'alternate in shorthand
rng.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=FINDCOMMENT(" & rng.Cells(1, 1).Address(0, 0, xlA1) & ", $X$1)"
Using .Cells(1, 1) should make that formula reference the upper left cell in rng.
I need to find various data in a sheet and select those data and print the selected data to printout and all data to be printed in one page. I tried with this code but something is wrong:
Sub Selection()
Dim varRow As String
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Range("A" & i).Value = "M655" Or Range("A" & i).Value = "Equity Fund" Then
If Trim(varRow) <> "" Then
varRow = varRow & "," & i & ":" & i
Else
varRow = varRow & i & ":" & i
End If
End If
Next i
Range(varRow).Select
Selection.PrintOut
With ActiveSheet.PageSetup
.PrintTitleRows = "$3:$3"
.PrintTitleColumns = "$B:$B"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End with
End Sub
One issue is that after you loop through the cells, varRow is a string of "M655" and "Equity Fund" separated by commas. You then try to use that string as an argument for a range which is invalid. If you are trying to build a a string of range addresses ("a1", "a2", etc) try using the .AddressLocal property. Also, you use .PrintOut prior to setting the print settings. Try putting that line after you set the page setup settings to have them take effect.
In the code below, I take some input parameters, either text or a cell, and combine them to form one string using the formatting I need. I need to make Task_Name bold, as well as text like "Lead :". I know you cannot make text in a variable bold, but how do I go about this? This cell I'm storing the value in is eventually used in a Word mail merge.
I need to format part of a string. In the code below, I need to make Task_Name, "Lead : ", etc. all bold.
Function GENERATE_STAFFING_SECTION(Task_Name, Lead_By, Members, Instructions)
Dim tmpSection As String
If Len(Task_Name > 0) And Len(Lead_By) > 0 And Len(Members) > 0 And Len(Instructions) > 0 Then
tmpSection = vbLf _
& Task_Name _
& vbLf & "Lead : " & Lead_By _
& vbLf & "Ambassadors : " & Members _
& vbLf & "Instructions : " & Instructions _
& vbLf
Else
tmpSection = ""
End If
GENERATE_STAFFING_SECTION = tmpSection
End Function
Also, I know it's not the cleanest code, so if there are any other suggestions for improving it, they are most welcome.
Thanks!
You can't add anything to the string directly to make the cell have bold characters.
Once you've written the string out to the cell, you'll need to go back and reprocess the cell.
For example:
With ActiveCell.Characters(Start:=11, Length:=6).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
This snippet will set only a portion of the cell to bold.
EDIT:
This code could be used to implement the above and give you what you want.
It could be written better, but should give you an idea of what you've got to write:
Public Sub FormatOuput()
Dim i As Integer
'Format Task_name
i = InStr(1, ActiveCell.Text, vbLf)
MakeBold 1, i
'Format 'Lead'
MakeBold i + 1, 4
'Format 'Ambassadors'
i = InStr(i + 1, ActiveCell.Text, vbLf)
MakeBold i+1, 11
'Format 'Instructions'
i = InStr(i + 1, ActiveCell.Text, vbLf)
MakeBold i+1, 10
End Sub
Public Sub MakeBold(startPos As Integer, charCount As Integer)
With ActiveCell.Characters(start:=startPos, length:=charCount).Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
End Sub