Create a cell comment from a vlookup or xlookup

Gem866

New Member
Joined
Feb 11, 2015
Messages
16
I am using Excel on a Mac and I can insert VBA code through the developer tab.

The purpose of this spreadsheet is to have a visual of sites allocated & available on a campground and will be used for an annual camping event for our organisation.

I have two sheets in my workbook (See attached images being screen shots of the worksheets)
Sheet1 has data in two columns. Column A is 'Site Number' Column B is 'Camper Name'
Sheet 2 has a site map layout so for example Row 4 shows sites 1 to 13 with 1 site allocated per column eg A4 = 1. (site 1), M4=13 (Site 13)

I currently have conditional formatting on Sheet 2 on the site numbers which does a lookup and if there is a name beside the site number from sheet 1 it will colour the cell red (meaning not available) but if the camper name from sheet 1 is blank it colours the cell green (meaning available). The conditional formatting is all good and working well. I created the conditional formatting using an xlookup function.

What I want to be able to do now is for a comment to be automatically added to the corresponding site number cell on sheet 2. That comment data comes from a lookup from sheet 1. The comment is to be the camper name, which is column B sheet 1. Of course if that camper name on Sheet 1 changes or is deleted the comment will need to update or be deleted accordingly.

Example, if on sheet 1, site 10 has the camper name 'John' then I want a comment added to site 10 on sheet 2. When I select site 10 in sheet 2 I want a comment box to pop up that says John. If there is no camper associated with site 10 I dont want the comment box created.

It should be noted that this is just a sample set of data it could well be that we are dealing with 500 sites or more all up, meaning on sheet 1 columns A & B could run down to row 500 or more.

Can this be done via VBA ?

Screenshot 2023-09-09 at 3.33.30 pm.jpg
Screenshot 2023-09-09 at 3.36.26 pm.jpg


Look forward to any help you can provide.

With thanks
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
a comment to be automatically added
Will require a Worksheet Change event triggered code. The following should do what you want, but please note the ranges for sheet 2 will have to be adjusted according to your "500" sites. Please try on a copy of your workbook. Right click the sheet tab for sheet 1, select View Code, and puth the code in the empty window that appears on the right of the screen.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not _
    Intersect(Range("B6:B" & Cells(Rows.Count, "A").End(xlUp).Row), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Dim n As String, s As String, SiteNum As Range, com As Comment
        n = Target.Value
        s = Target.Offset(, -1).Value
        Set SiteNum = Worksheets("Sheet2").Range("A4:M6").Find(s)
        
        With SiteNum
            .ClearComments
            If n <> "" Then .AddComment (n)
        End With
        
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
 
Upvote 0
Solution
Will require a Worksheet Change event triggered code. The following should do what you want, but please note the ranges for sheet 2 will have to be adjusted according to your "500" sites. Please try on a copy of your workbook. Right click the sheet tab for sheet 1, select View Code, and puth the code in the empty window that appears on the right of the screen.
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge = 1 And Not _
    Intersect(Range("B6:B" & Cells(Rows.Count, "A").End(xlUp).Row), Target) Is Nothing Then
        On Error GoTo Escape
        Application.EnableEvents = False
        Dim n As String, s As String, SiteNum As Range, com As Comment
        n = Target.Value
        s = Target.Offset(, -1).Value
        Set SiteNum = Worksheets("Sheet2").Range("A4:M6").Find(s)
       
        With SiteNum
            .ClearComments
            If n <> "" Then .AddComment (n)
        End With
       
    End If
Continue:
    Application.EnableEvents = True
    Exit Sub
Escape:
    MsgBox "Error " & Err.Number & ": " & Err.Description
    Resume Continue
End Sub
Thank you that has worked perfectly. I acknowledge the change that will need to be made to the range for sheet 2 when more sites are added.
 
Upvote 0
Thank you that has worked perfectly. I acknowledge the change that will need to be made to the range for sheet 2 when more sites are added.
Happy to help, and thanks for the feedback 👍
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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