Inserting/Displaying Arrow (Up or Down) in a cell on Comparision

[dvrajaneesh]

Hi,
I have the as shown below, currently am manually comparing the yellow & green cells (C&D Columns)and accordingly inserting arrow symbols in MoM cells (F&G Columns).. I have to the same thing no.of sheets every month..

Pls help me with any formula or a macro which will reduce my donkey work..

Thanks,
Raj.

 

[dvrajaneesh]

Guyss... Can anybody help me out...???

 

[Armando Montes]

Look here:
Customize Excel Conditional Formatting Icons | Contextures Blog

 

[jolivanes]

Use a copy of your workbook to try.
I don't know if it will work on merged cells.

Something like this:
(Thanks to snb)

With Range("F2:G2")
.Font.Size = 22    '????
.Font.Name = "Wingdings 3"
.Formula = "=If(RC[-1]<R[-1]C[-1],CHAR(200),IF(RC[-1]=R[-1]C[-1],CHAR(198),CHAR(199)))"
Note: The above formula pertains to one of my sheets and not your example. Change as required.
.Value = .Value
End With

The Char(198, 199 and 200) are up, down and sideways arrows in Wingdings 3 Font

You can include Select Case to color the arrows.

For instance

For Each cel In Range("C8:G8")    '<---- Change to fit your requirements
Select Case cel.Value
Case 0
cel.Offset(, 1).Font.Color = vbBlue
Case Is < 0
cel.Offset(, 1).Font.Color = vbRed
Case Is > 0
cel.Offset(, 1).Font.Color = vbGreen
 End Select
 Next cel

Note: This is not tailored to your requirements, it is from one of my workbooks.
I don't have the time now but in the meantime you'll have something to play with.
If you can't get it working, let us know.
Good luck.

 

[jolivanes]

This assumes that you have a full year from Jan to Dec in cells B1 to M1.
The values that are compared are in B4:M4 and B2:M2
The MoM for each month are from N1 toY1.
The arrows for each month are from N2/N4 (Merge and Center, Middle Align, Center) toY2/Y4 (Merge and Center, Middle Align, Center).

On a copy of your workbook, try this.

Sub Try_This()
    Dim c As Range
    With Range("N2:Y2")
        .Font.Size = 36
        .Font.Name = "Wingdings 3"
        .Formula = "=If(R[2]C[-12]<RC[-12],CHAR(200),IF(R[2]C[-12]=RC[-12],CHAR(198),CHAR(199)))"
        .Value = .Value
    End With
    For Each c In Range("B4:M4")
        If c.Value < c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbRed
        If c.Value > c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbGreen
        If c.Value = c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbBlue
    Next c
End Sub

I hope someone will change this to a more robust code

 

[jolivanes]

Sub Try_This()
Dim c As Range
With Range("N2:Y2")
.Font.Size = 36 '????
.Font.Name = "Wingdings 3"
.Formula = "=If(R[2]C[-12]<RC[-12],CHAR(200),IF(R[2]C[-12]=RC[-12],CHAR(198),CHAR(199)))"
.Value = .Value
End With
For Each c In Range("B4:M4")
If c.Value < c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbRed
If c.Value > c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbGreen
If c.Value = c.Offset(-2).Value Then c.Offset(-2, 12).Font.Color = vbBlue
Next c
End Sub

The previous post did not keep the whole code. Tried changing but no luck.
This post did the same with the code in square brackets and forward slash+code in square brackets so I left these out.
Could someone tell me what I am doing wrong please