Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

How to insert cell data into comment field. 1

Status
Not open for further replies.

socomfort

Technical User
Jul 8, 2005
46
US
Hi,

I have a spreadsheet that has 7 columns of data (Sheet2). Another sheet in the same workbook (Sheet1) has one column and it is the same as the first column in Sheet2.

I use code generously provided by someone in response to an earlier question to search for like values in that first column and insert comment boxes into the column in Sheet1 (my target sheet):

Code:
Dim rw1 As Integer, rw2 As Integer
For rw2 = 2 to 100
  Name = Sheets("Sheet1").Cells(rw2, 1)
  For rw1 = 2 to 100
    If Sheets("Sheet2").Cells(rw1, 1) = Name Then
    For cl = 1 to 1
    Sheets("Sheet1").Cells(rw2, cl).AddComment
    Sheets("Sheet1").Cells(rw2, cl).Comment.Visible = True
    Next
    End If  
Next
Next

End Sub

So far, this routine correctly matches the values from the first column in each sheet. Sheet2 is the one that contains the remaining columns of data.

For each value that I find in Sheet2, I want to grab the remaining column values and concatenate them in a string of some type that I can populate into the comment boxes:

Something like:

Code:
.Comment.Text:="TEXT HERE" & Chr(10) & "ADDITIONAL TEXT"...

I am not sure how to create a string with that data. I am stumped. Thanks in advance of your help.

Ben
 
Hi Ben,

Try something like:
Code:
Sub Test()
Dim rw1 As Integer, rw2 As Integer
Dim oCmt
'skip over errors caused by trying to delete comments in cells with no comments
On Error Resume Next
For rw2 = 2 To 100
    With Sheets("Sheet1")
        If Trim(.Cells(rw2, 1)) <> "" Then
            If .Cells(rw2, 1) = Sheets("Sheet2").Cells(rw2, 1) Then
                For rw1 = rw2 To 100
                    If Trim(.Cells(rw1, 1)) <> "" Then
                        If rw1 = rw2 Then
                            oCmt = Sheets("Sheet2").Cells(rw1, 1).Value
                        Else
                            oCmt = oCmt & Chr(10) & Sheets("Sheet2").Cells(rw1, 1).Value
                        End If
                    End If
                Next
            End If
            With .Cells(rw2, 1)
                .Comment.Delete
                .AddComment
                'copy the formula into the comment box
                With .Comment
                    .Text Text:=Trim(oCmt)
                    .Visible = True
                    .Shape.TextFrame.AutoSize = True
                End With
            End With
            oCmt = ""
        End If
    End With
Next
End Sub

Cheers

[MS MVP - Word]
 
Hi Macropod!

Thanks for your help. Your code works nicely. However, what it does is the following:

It loops through and compares row by row for each item in the first column and inserts comments in every field on Sheet1. The comment boxes are blank b/c it is comparing rw2 = 2 to rw1 = 2 and so forth. What I am trying to get it to compare rw2 = 2 to rw1 = 2, 3, 4... until it finds a match. Let me explain.

What I have is the following:

Sheet2 has for columns:
Column1 Column2 Column3 Column4
Text1 Value11 Value12 Value13
Text2 Value21 Value22 Value23
Text3 Value31 Value32 Value33

Sheet1 only has one column:
Column1
OtherText
Text1
Text1
OtherText
OtherText
OtherText
Text2
OtherText
BLANK
Text2
OtherText
OtherText
Text3
Text2
Text3

What I am tring to get it to do is find the three fields in
in Sheet2 on Sheet1. When it finds one, then insert a comment on the field that matches the field on Sheet1 and then populate that comment box with the other columns in Sheet2 only for the field that matched.

I have other code that does find the right field, however, it uses a For Loop. I am not sure how to incorporate it into this code.

How can I modify your code to match the fields in question and populate only the comment boxes for the matched data values? I am very new at this, and I am struggling to understand it. Again, thanks very much for your help. I hope my example above is clear.

-Ben
 
Hi ben,

I coded the macro to do as specified:
For each value that I find in Sheet2, I want to grab the remaining column values and concatenate them in a string of some type that I can populate into the comment boxes.
I understood the to mean the remaining values in that column. I now gather from
populate that comment box with the other columns in Sheet2 only for the field that matched
that you want all the values on the matched row. Is this correct? If so, the code will take a bit of re-working.

Cheers

[MS MVP - Word]
 
Oh man, Macropod. I am terribly sorry for the confusion. Yes, you are right. I am trying to find the data in columns 2 through 12 on the matched rows and put this data into the comment boxes that I am inserting on Sheet1.

So on Sheet2 I have columns 1 through 12. Column 1 on Sheet2 has the same type of data as Column 1 on Sheet1. Column 1 on Sheet1 is a long list of Job Numbers; there are no other columns on this sheet. Column 1 on Sheet2 contains three discrete Job Numbers and their related data. I want to match these three Job Numbers to any and all instances of these numbers on Sheet1.

When I find them (and there may be many instances of these three numbers), I am trying to insert a comment box, and push the data from columns 2 through 12 for each matched row into the comment box.

I attempted to incorporate your code as follows:

Code:
Sub TESTObj()
Dim rw1 As Integer, rw2 As Integer, oCmt As String
For rw2 = 2 To 100
    Name = Sheets("Sheet1").Cells(rw2, 1)
    For rw1 = 2 To 100
        If Sheets("Sheet2").Cells(rw1, 1) = Name Then
                    
                For cl1 = 1 To 1
                Sheets("Sheet1").Cells(rw2, cl1).AddComment
                Sheets("Sheet1").Cells(rw2, cl1).Comment.Visible = True
            
                    For cl2 = 2 To 12
                        oCmt = oCmt & Sheets("Sheet2").Cells(rw1, cl2).Value & Chr(10)
'copy the formula into the comment box
              With Sheets("Sheet1").Cells(rw2, cl1).Comment
                         .Text Text:=Trim(oCmt)
                         .Visible = True
                         .Shape.TextFrame.AutoSize = False
              End With
              oCmt = ""
                    Next
                Next
        End If
    Next
Next

End Sub

It does find the correct Job Numbers and does create the comment boxes where I need them. However, I cannot create the string to push the data into the comment boxes.

I am grateful for your willingness to help. Again, I didn't mean to be so confusing about this. It's just hard for me to articulate it since I am having trouble understanding it myself.

thanks again for your willing help,

Ben
 
Hi Ben,

Try this re-worked version of the code.

I've added more commentary to explain what the code is doing.
Code:
Sub Test()
Dim oRow As Integer, oCol As Integer
Dim oCmt As String
'skip over errors caused by trying to delete comments in cells with no comments
On Error Resume Next
' process rows 2 To 100
For oRow = 2 To 100
    With Sheets("Sheet1")
        'skip if the cell is empty
        If Trim(.Cells(oRow, 1)) <> "" Then
            ' process matching rows on sheets 1 & 2
            If .Cells(oRow, 1) = Sheets("Sheet2").Cells(oRow, 1) Then
                'store Sheet2 col1 value
                oCmt = Sheets("Sheet2").Cells(oRow, 1).Value
                ' store remaining Sheet2 col values, inserting a linefeed before each
                For oCol = 2 To Sheets("Sheet2").Cells(oRow, 1).End(xlToRight).Column
                    oCmt = oCmt & Chr(10) & Sheets("Sheet2").Cells(oRow, oCol).Value
                Next
            End If
            'on Sheet1
            With .Cells(oRow, 1)
                'delete any existing comment
                .Comment.Delete
                ' insert a new comment
                .AddComment
                'copy oCmt into the comment box
                With .Comment
                    .Text Text:=Trim(oCmt)
                    .Visible = True
                    .Shape.TextFrame.AutoSize = True
                End With
            End With
            'clear oCmt
            oCmt = ""
        End If
    End With
Next
End Sub

You'll note that the comment additions stop at the last-filled column on the relevant row. If you want to use 12 rows always, change:
'Sheets("Sheet2").Cells(oRow, 1).End(xlToRight).Column'
to:
'12'.

Cheers

[MS MVP - Word]
 
Hi Macropod,

This works great! Thanks so much for your help. Enjoy the star, bud.

Ben
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top