Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 279
  • Last Modified:

Add a comment with information in it? In VBA?

Hello,

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?

Thanks,

GISVPN
Book1.xlsx
0
gisvpn
Asked:
gisvpn
1 Solution
 
Robert SchuttSoftware EngineerCommented:
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)
                Else
                    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
                Else
                    col2.Add prs, hrs
                    col2.Add C_PREFIX_COUNT & prs, 1
                End If
                Set colData(cod) = col2
            Next
        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
        Next
        colData(cod) = cmt
        Debug.Print "*" & cod & vbCrLf & cmt
    Next
    With Sheets("summary")
        With .UsedRange
            blnFirstRow = True
            For r = 1 To .Rows.Count
                If blnFirstRow Then
                    If intColCode > 0 Then blnFirstRow = False
                Else
                    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
                    Else
                        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
                Next
            Next
        End With
    End With
    ' clean up
    colData.RemoveAll
    Set colData = Nothing
End Sub

Open in new window

0

Featured Post

Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now