Add a comment with information in it? In VBA?

Posted on 2012-08-12
Last Modified: 2012-09-21

I have a question - but I am not sure if it can be done.

I have a spreadsheet as attached which I would like to add comments (via vba) into the summary tab in cells J15,16,17,18,19 and 20. I would like to comments to be information derived from data on the data tab - i'll try to explain a little more.

On the summary tab there is a code i.e. in F15,16,17 etc.. This code will match up with one listed on the datasheet column E. On the data sheet there is also a name in column F and a number (hours) in column J.

I would like the VBA code to start with cell J15 and insert a comment (as in the spreadsheet example attached) each time the code shown in F15 is found on the data tab in column E - but I would like it to summarise names found in column F and the total hours in column J.

Each line in the comment added should show the following (as in the attached example).

(1) Joe - 4 Hours

The (1) is the number of times 'Joe' was found against the code in F15. 'Joe' is the name found and '- 4 hours' is the total of the figures found against Joe under the code shown in F15.

Hopefully the attached spreadsheet will help get my requirement across alot more than here ;)

Can this be done at all?


Question by:gisvpn
    1 Comment
    LVL 35

    Accepted Solution

    This goes a long way towards your goal I believe, it needs some cleaning up, checking for empty values and such.
    Option Explicit
    Const C_PREFIX_COUNT = "#count#"
    Sub SetComments()
        Dim colData, col2, r, c, intColCode, intColRes, blnFirstRow, cod, prs, hrs, cmt
        Set colData = CreateObject("Scripting.Dictionary")
        With Sheets("data")
            With .UsedRange
                For r = 1 To .Rows.Count
                    cod = .Cells(r, 5).Value
                    prs = .Cells(r, 6).Value
                    hrs = .Cells(r, 10).Value
                    If colData.Exists(cod) Then
                        Set col2 = colData(cod)
                        Set col2 = CreateObject("Scripting.Dictionary")
                    End If
                    If col2.Exists(prs) Then
                        col2(prs) = col2(prs) + hrs
                        col2(C_PREFIX_COUNT & prs) = col2(C_PREFIX_COUNT & prs) + 1
                        col2.Add prs, hrs
                        col2.Add C_PREFIX_COUNT & prs, 1
                    End If
                    Set colData(cod) = col2
            End With
        End With
        For Each cod In colData
            cmt = ""
            For Each prs In colData(cod)
                If Left(prs, Len(C_PREFIX_COUNT)) <> C_PREFIX_COUNT Then
                    If cmt <> "" Then cmt = cmt & Chr(10)
                    cmt = cmt & "(" & colData(cod)(C_PREFIX_COUNT & prs) & ") " & prs & " - " & colData(cod)(prs) & " hours"
                End If
            colData(cod) = cmt
            Debug.Print "*" & cod & vbCrLf & cmt
        With Sheets("summary")
            With .UsedRange
                blnFirstRow = True
                For r = 1 To .Rows.Count
                    If blnFirstRow Then
                        If intColCode > 0 Then blnFirstRow = False
                        cod = .Cells(r, intColCode)
                    End If
                    For c = 1 To .Columns.Count
                        If blnFirstRow Then
                            If .Cells(r, c).Value = "Code" Then intColCode = c
                            If .Cells(r, c).Value = "Resource" Then intColRes = c
                            Debug.Print "Cells(" & r & ", " & c & ") = '" & .Cells(r, c).Value & "'"
                            If c = intColRes Then
                                cod = .Cells(r, intColCode)
                                cmt = ""
                                If colData.Exists(cod) Then cmt = colData(cod)
                                If Not .Cells(r, c).Comment Is Nothing Then
                                    .Cells(r, c).ClearComments
                                End If
                                .Cells(r, c).AddComment
                                .Cells(r, c).Comment.Text cmt ', , True
                            End If
                        End If
            End With
        End With
        ' clean up
        Set colData = Nothing
    End Sub

    Open in new window


    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Highfive + Dolby Voice = No More Audio Complaints!

    Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

    Suggested Solutions

    Dealing with unintended Excel Active-X resizing quirks (VBA code simulates "self correction") David Miller (dlmille) Intro Not everyone is a fan of Active-X controls in spreadsheets (as opposed to the UserForm approach, the older Form controls …
    This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
    This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
    This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now