2

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?

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
Alex D.
  • 41
  • 6
  • For the image problem, can you try using (copy and paste) these ? =SE(L2=M2;"L and M are equal"; SE(L2>M2;"L is greater than M ▲";"L is less than M ▼")) – Ken Lee Dec 13 '20 at 11:54

2 Answers2

3

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

Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • Hi, yesterday i thought it was enough to use the character arrow you suggested me, instead today i've been asked to consider an image more than a character symbol, for example the shapes inside the "Insert" panel, can you help me to embed those shapes inside a macro? – Alex D. Dec 14 '20 at 15:11
  • `for example the shapes inside the "Insert" panel` The above symbol is present in the `Insert-Symbol` table but if you have a specific symbol in mind then share that. – Siddharth Rout Dec 14 '20 at 15:19
  • thanks a lot, i recorder this video to show what i mean. https://drive.google.com/file/d/161ippLgysRoclvpEUtO1XjXfDLl4HSXD/view?usp=sharing i also need that arrow to behave like a text, for example when i delete the cell the arrow still remains there and i woull avoid this. – Alex D. Dec 14 '20 at 15:45
  • Whoever asked you to do this needs to understand that this is really a bad idea. The shapes can be shown and hidden but it is too much of a headache **1.** To insert/delete shapes you will have to use `Worksheet_Change` Event. If there are 1000 cells then in a worst case scenario there will be 1000 arrows. A nightmare to handle! **2.** You will also have to ensure that the shapes grow, shrink or change placement when a user resizes the row/column. – Siddharth Rout Dec 14 '20 at 19:44
  • do you have other ideas instead to use shapes? do you think is better using icons? – Alex D. Dec 15 '20 at 08:29
  • Do you know that you cna choose a relevant symbol from `Insert | Symbol` – Siddharth Rout Dec 15 '20 at 08:36
  • i think your option is great honestly, just one more thing, 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. Dec 15 '20 at 10:25
  • Let us [continue this discussion in chat](https://chat.stackoverflow.com/rooms/225976/discussion-between-siddharth-rout-and-alex-d). – Siddharth Rout Dec 15 '20 at 11:06
1

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

Gary's Student
  • 95,722
  • 10
  • 59
  • 99
  • Hi Gary, i modified your code putting the string: "L is greater than M " & _ChrW(&H2191) instead of: txt = "n" this is the output: L is greater than M ↑ Is there a way, using your previous code, to change the size and color of just ↑ character? – Alex D. Dec 15 '20 at 11:50