VBA Code to Add a Comment to a Cell based on that Cells Content

albert_de

New Member
Joined
Mar 16, 2020
Messages
22
Office Version
  1. 2021
Platform
  1. Windows
Hi

I do not know VBA and I am hoping that someone may be able to guide me with some coding. I have been searching a solution for a week or so, and they are out there. I just don't know how to apply that coding to my project.

The setup:

1. In Column AN20:AN26, I have a list of abbreviations (e.g. DD, DC, T, etc.)
2. In Column AO20:AO26, I have the definitions for those abbreviations (e.g. Direct Debit, Direct Credit, Transfer,etc.). These are exactly adjacent to the list of abbreviations in Column AN20:AN26
3. In Column B9:B12 and B19:B200, I have a drop down list that contains the abbreviations (e.g. DD, DC, T,etc.) from the list in Column AN20:AN26 (I don't think it matters to this, but these abbreviations have Text and Fill Conditional Format Rules attached to them in this column).

I would like to be able to do the following:

When selecting an abbreviation from the Drop Down List in Column B9:B12 and B19:B200, I would like to automatically assign the matching definition (from Column AO20:AO26) as a Comment in that cell.
e.g.
1. In Cell B9 - DD is selected from the Drop Down List
2. Then, Direct Debit is the automatically added as a comment to Cell B9.

Rules:
1. If a Cell in Column B9:B12 and B19:B200 = empty or is changed to be made empty, then there should be no comment or the existing comment is removed.
2. If a Cell in Column B9:B12 and B19:B200 = contains a selected abbreviation, then the matching definition should be added as a comment in that cell
3. If a Cell in Column B9:B12 and B19:B200, already contains an abbreviation but that abbreviation is changed, then the matching definition of the changed cell should be refreshed to match the changed cell.

Thanks to Member "Akuini", this workbook already has some VBA code in it (Private Sub Worksheet_Change(ByVal Target As Range)). I am hoping to learn how to add your solution to my query to "Akuni's" code.

Thank you for your help.
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi Kevin,

Could you please help me with you code again?

I have moved the helper formulas from the original worksheet that your VBA code refers to a separate worksheet (named: UBank Save-Very Hidden / Sheet12) so that I can make it a "Very Hidden" worksheet, but this now throws up an error and does not include the adjacent Abbreviation Definition from the Sheet12 range K19:K27.

I had a go at updating the worksheet reference in the "s=" line of the VBA code (see in bold below), but I don't think that I have applied it correctly, as the error still occurs and there is still no Abbreviation Definition from the Sheet12 range K19:K27.

Could you please help identify and correct for me where I have gone wrong with your code?

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.CountLarge = 1 And Not Intersect(Range("B9:B12,B20:B300"), Target) Is Nothing Then
Application.EnableEvents = False
If Target = "" Then
With Target
If Not .Comment Is Nothing Then .Comment.Delete
End With
Else
With Target
If Not .Comment Is Nothing Then .Comment.Delete
Dim s As String
s = WorksheetFunction.VLookup(Target, Range("'UBank Save-Very Hidden'!J19:K27"), 2, False)
With .AddComment
.Text s
With .Shape
With .TextFrame.Characters.Font
.Name = "Calibri Light"
.Italic = True
.Size = 11
End With
End With
End With
End With
End If
End If
Application.EnableEvents = True
End Sub

I hope that this query make some sense! Thank you for and help that you can offer me.
 
Upvote 0
Change this:
VBA Code:
s = WorksheetFunction.VLookup(Target, Range("'UBank Save-Very Hidden'!J19:K27"), 2, False)

to this:
VBA Code:
s = WorksheetFunction.VLookup(Target, Sheets("UBank Save-Very Hidden").Range("J19:K27"), 2, False)
 
Upvote 0
Solution
Hi Kevin,
Excellent, thank you. That works perfectly. You are a legend and thank you again for your help.
 
Upvote 0

Forum statistics

Threads
1,215,984
Messages
6,128,110
Members
449,421
Latest member
AussieHobbo

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top