Question : How can I automatically (VBA) insert a comment when certain condition exist in a cell;

How can I automatically (VBA) insert a comment when certain condition exist in a cell;
If I got two cells, A1 has value for overtime allowed and cell B2 has actual overtime worked. If cell B2 is greater than cell A1, is it possible to automatically insert a comment with the variance actual to allowed? In another words the difference (plus/minus). You may ask why just not show them in another cell, well Im short of real state, I got this dashboard and I have to do this in several rows and this may save me some space.

I have attached a workbook sample I got 28 Depts. and I need a comment in each cell showing the difference in the comment box without the user name on the comment box.

Thanks in advance for the input

Answer : How can I automatically (VBA) insert a comment when certain condition exist in a cell;

Try the following:

1. The code should be placed in the worksheet code page.
2. The change sub will update the comment in the cells should a datum change in either row.
3. The iniall sub can be run to initialise all the cells in the row at once

Chris

                       
         
           
             1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:

           
           
             Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim col As Range
Dim str As String
 
    Application.EnableEvents = False
    Set rng = Intersect(Target, Range("4:5"))
    If Not rng Is Nothing Then
        For Each col In rng.Columns
            If IsNumeric(Cells(4, col.Column)) And Cells(5, col.Column) <> "" And IsNumeric(Cells(4, col.Column)) And Cells(5, col.Column) <> "" Then
                str = Cells(4, col.Column) - Cells(5, col.Column) & ", (Variance to Allowed)"
                With Cells(4, col.Column)
                    .ClearComments
                    .AddComment
                    .Comment.Visible = False
                    .Comment.Text Text:=str
                    .Comment.Shape.TextFrame.AutoSize = True
                End With
            End If
        Next
    End If
    Application.EnableEvents = True
End Sub
 
Sub iniall()
Dim rng As Range
Dim cel As Range
 
    Set rng = Range("4:4")
    For Each cel In rng.Cells
        If IsNumeric(cel) And cel.Offset(1, 0) <> "" And IsNumeric(cel) And cel.Offset(1, 0) <> "" Then
            cel = cel
        End If
    Next
 
End Sub
           
         

Open in New Window

Select All