Compare two cells and show output with symbol

Viewed 171

I've been asked to create a macro that compare two numbers in two cells and then it should write a third column that says for example: L6 is less than M6 (any image of a down arrow)

I tried to record this macro:

Sub Macro20()
    Range("N2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-2]=RC[-1],""L and M are equal"",IF(RC[-2]>RC[-1],""L is greater than M (UP ARROW) "",""L is less than M (DOWN ARROW)""))"
    Range("N2").Select
    
    Selection.AutoFill Destination:=Range("N2:N" & Range("L" & Rows.Count).End(xlUp).Row)
    Range(Selection, Selection.End(xlDown)).Select
End Sub

and this is the output:

enter image description here

This is just an example, the whole code should be used to a large amount of data soon, anyway there are some errors must be avoided.

  1. The code into the cell must not be shown (see the blue arrow into the picture), it should display only the value.
  2. How can I fetch an arrow image instead of the string: L is greater than M (UP ARROW)?

Can you help me in doing a better code than this?

2 Answers

Here is a simple solution which enters the formula in the entire range without looping.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last row in column L
        lRow = .Range("L" & .Rows.Count).End(xlUp).Row
        
        '~~> Insert the formula in Col N. Change as applicable
        With .Range("N1:N" & lRow)
            .Formula = "=IF(L1=M1,""L and M are equal"",IF(L1>M1,""L is greater than M " & _
                       ChrW(&H2191) & _
                       """, ""L is less than M " & _
                       ChrW(&H2193) & _
                       """))"
            '~~> Optional - Convert formula to values
            .Value = .Value
        End With
    End With
End Sub

Screenshot

enter image description here

Note:

  1. To insert Up arrow, you can use ChrW(&H2191) and for down arrow you can use ChrW(&H2193)

  2. If you want to put the formula from the 2nd row then it will be

     '~~> Insert the formula in Col N. Change as applicable
     With .Range("N2:N" & lRow)
         .Formula = "=IF(L2=M2,""L and M are equal"",IF(L2>M2,""L is greater than M " & _
                    ChrW(&H2191) & _
                    """, ""L is less than M " & _
                    ChrW(&H2193) & _
                    """))"
         '~~> Optional - Convert formula to values
         .Value = .Value
     End With
    

Similarly for a different row, you will have to adjust accordingly.


EDIT

do you think is possible to use a arrow text already formatted? For example a red one (or whatever color) with a specific size? And then put this inside your vba code? – Alex D. 4 hours ago

Yes it is possible. In this case you can use Worksheet_Change event to handle changes in column L and column M to populate column N

I have commented the code below. If you still have problems understanding it then feel free to ask. The below code goes in the sheet code area. You can change the symbol attributes (Style, Color and Size) right at the top of the code.

Code

Option Explicit

'~~> Change the symbol attributes here
Const Font_Style As String = "Bold"
Const Font_Size As Long = 15
Const Font_Color As Long = -16776961 '(Red)

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Whoa
    
    Application.EnableEvents = False
    
    Dim r  As Variant
    
    '~~> Check if the change happened in the relevant column
    If Not Intersect(Target, Me.Range("L:M")) Is Nothing Then
        For Each r In Target.Rows
            '~~> If even one cell is empty then clear out N cell
            If Len(Trim(Range("L" & r.Row).Value2)) = 0 Or _
               Len(Trim(Range("M" & r.Row).Value2)) = 0 Then
                Range("N" & r.Row).ClearContents
            '~~> Check if L = M
            ElseIf Range("L" & r.Row) = Range("M" & r.Row) Then
                Range("N" & r.Row).Value = "L and M are equal"
            '~~> Check if L > M
            ElseIf Range("L" & r.Row) > Range("M" & r.Row) Then
                With Range("N" & r.Row)
                    .Value = "L is greater than M " & ChrW(&H2191)
                    
                    '~~> Format the symbol which is at 21st position
                    With .Characters(Start:=21, Length:=1).Font
                        .FontStyle = Font_Style
                        .Size = Font_Size
                        .Color = Font_Color
                    End With
                End With
            '~~> L < M
            Else
                With Range("N" & r.Row)
                    .Value = "L is less than M " & ChrW(&H2193)
                    
                    '~~> Format the symbol which is at 18th position
                    With .Characters(Start:=18, Length:=1).Font
                        .FontStyle = Font_Style
                        .Size = Font_Size
                        .Color = Font_Color
                    End With
                End With
            End If
        Next r
    End If
    
Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

In action

enter image description here

Here is an alternative:

Sub alex()
    Dim i As Long, LastRow As Long
    Dim L, M, txt As String
    LastRow = Cells(Rows.Count, "L").End(xlUp).Row
    
    For i = 2 To LastRow
        L = Cells(i, "L").Value
        M = Cells(i, "M").Value
        
        If L = M Then
            txt = "they are equal"
        ElseIf L > M Then
            txt = "L is greater"
        Else
            txt = "M is greater"
        End If
        
        Cells(i, "N") = txt
    Next i
End Sub

enter image description here

You can speed this up a little by bring all the column L and M data into VBA arrays and doing the comparisons within VBA.

To get arrows rather than text, use:

Sub alex()
    Dim i As Long, LastRow As Long
    Dim L, M, txt As String
    LastRow = Cells(Rows.Count, "L").End(xlUp).Row
    
    For i = 2 To LastRow
        L = Cells(i, "L").Value
        M = Cells(i, "M").Value
        
        If L = M Then
            txt = "n"
        ElseIf L > M Then
            txt = "h"
        Else
            txt = "i"
        End If
        
        Cells(i, "N") = txt
    Next i
End Sub

and format the results cells in column N to use the Wingdings 3 font

Related