Insert a cell location in condition formatting - excel

Question

so I have a code like this:
Sub ApplyIconSets()
Dim rng As Range
Dim iset As IconSetCondition
Set rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
rng.Name = "selected"
LastRow = Range("selected").Rows.Count
LastColumn = Range("selected").Columns.Count
With Range("selected")
For i = 2 To LastColumn
For r = 1 To LastRow
Set iset = .Cells(r, i).FormatConditions.AddIconSetCondition
With iset
.IconSet = ActiveWorkbook.IconSets(xl3Arrows)
.ReverseOrder = False
.ShowIconOnly = False
End With
With iset.IconCriteria(2)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = Range("selected").Cells(r, i).Offset(, -1)
End With
With iset.IconCriteria(3)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = Range("selected").Cells(r, i).Offset(, -1)
End With
Next r
Next i
End With
End Sub
So basically this code applies IconSet condition formatting to a cell based on its preceding cell value. The code works perfectly fine, however there's one point I want to improve it.
When I check the condition applied, the code inputs the preceding cell absolute value instead of the cell's location.
Like This
However, I want the code to input the cell location, so that when I change the data, it still works instead of having me rerun the code.
Like this
I have tried to change
.Value = Range("selected").Cells(r,i).Offset(,-1).Address
But it returns a string, hence the condition won't work.
Anyone knows a solution?
Thanks in advance.

Answer 1

I'm not sure you've got your conditional format logic right. Your code as it stands will never show an amber arrow because IconCriteria(3) will evaluate first. Since IconCriteria(2) has identical property values, it will never be met. If you wanted the green arrow to display for numbers greater than the tested cell value and the amber arrow to display for numbers equal to the value, then you'd need to write the code as given below.
I'm also wondering if a ForEach loop might be simpler, especially as it would pass the cell range itself so you could just derive your workbook and worksheet objects from that. This would avoid a potential problems of your unqualified ranges. You'd simply need to add an If statement to ensure that you didn't try to offset past column 1.
All in all, then, the code below might serve your purposes. BTW I'd recommend adding Option Explicit at the top of your module and handling the case where the user hits Cancel on the input box:
Option Explicit
Sub ApplyIconSets()
Dim sel As Range, cell As Range
' Acquire the target range and handle a cancelled input box.
On Error GoTo Canx
Set sel = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
' Iterate cell by cell to add the condition.
On Error GoTo EH
For Each cell In sel.Cells
'Ignore the cell if it is in column 1.
If cell.Column > 1 Then
With cell.FormatConditions
'Delete existing conditions.
.Delete
'Add a new condition.
With .AddIconSetCondition
.IconSet = cell.Worksheet.Parent.IconSets(xl3Arrows)
'Set the amber criterion.
'Note: we have to use '>=' but anything '>' will be caught
'in the green operator, so only '=' will meet this criterion.
With .IconCriteria(2)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
End With
'Set the green criterion.
'Note: we have to use just '>' because this is evaluated first
'and '>=' would result in amber never capturing a value.
With .IconCriteria(3)
.Type = xlConditionValueFormula
.Operator = xlGreater
.Value = "=" & cell.Worksheet.Name & "!" & cell.Offset(, -1).Address
End With
End With
End With
End If
Next
Exit Sub
Canx:
Debug.Print "User cancelled."
Exit Sub
EH:
Debug.Print Err.Number; Err.Description
End Sub

Answer 2

Please try to define in each segment, the value as a reference to the cell like this:
With iset.IconCriteria(3)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = "=Sheet1!$B$1"
End With
You'd have to replace the string with variables to something like this:
.Value = "=Sheet1!" & Range("selected").Cells(r, i).Offset(, -1).Address
Please mark this answer if this helped you.

Answer 3

This code does what you want.
Sub ApplyIconSets()
Dim LastRow As Long, LastColumn As Long
Dim Rng As Range
Dim iSet As IconSetCondition
Dim i As Integer, R As Integer
Set Rng = Application.InputBox("Select a Range", "Obtained Range Object", Type:=8)
Rng.Name = "selected"
LastRow = Range("selected").Rows.Count
LastColumn = Range("selected").Columns.Count
With Range("selected")
For i = 1 To LastColumn
For R = 1 To LastRow
Set iSet = .Cells(R, i).FormatConditions.AddIconSetCondition
With iSet
.IconSet = ActiveWorkbook.IconSets(xl3Arrows)
.ReverseOrder = False
.ShowIconOnly = False
End With
With iSet.IconCriteria(2)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
End With
With iSet.IconCriteria(3)
.Type = xlConditionValueFormula
.Operator = xlGreaterEqual
.Value = "=" & Range("selected").Cells(R, i).Offset(, -1).Address
End With
Next R
Next i
End With
End Sub
I didn't want to spend the time experimenting further: I think that the condition can be set for the entire range in one go, causing Excel to set relative formatting instead of absolute. You may like to try that. There would be a difference in speed. You may also like to add code which deletes existing CF before applying the new. CF gets overloaded easily and will then slow down your sheet.