Multiple cells into comment

[Toomicek]

Hi there,

I want to add text from 3-5 cells in different sheets to one cell like commentary. I am not a pro in VBA so i need help

Added sample

Thanks

Thomas

 

[Toomicek]

LIKE THIS -
Before:

[COLOR=#FF0000]Set Changed = Intersect(Target, Range(CommentCells))
[/COLOR]

AFTER:

Set Changed = Range(CommentCells)[/COLOR]

 

[Peter_SSs]

Ah, silly mistake on my part, didn't reset the comment string to nothing for each new cell.

Add in the blue line where shown

c.ClearComments
cmt = ""
s = c.Text

 

[Toomicek]

Great job, that works but now sometimes format of text is bold. Like on picture "Th" is normal and next "is That There" is bold, maybe I broke something

And is there any posibility to run macro on one row only? It will be around 100+ rows and if it will calculate all row separately it will take too much time

Private Sub Worksheet_Change(ByVal Target As Range)  Dim Changed As Range, c As Range
  Dim s As String, cmt As String, sBold As String
  Dim aTLC As Variant, aData As Variant, aBold As Variant
  Dim i As Long, Tbl As Long
  Dim bStarted As Boolean
  
  Const TopLeftCells As String = "A1 D1 G1" '<- Top left cell of each table
  Const CommentCells As String = "J4:J8"  '<- Range to add/delete/edit comments
  
  Set Changed = Range(CommentCells)
  If Not Changed Is Nothing Then
    aTLC = Split(TopLeftCells)
    For Each c In Changed
      c.ClearComments
      s = c.Text
      cmt = ""
      If Len(s) > 0 Then
        For Tbl = 0 To UBound(aTLC)
          aData = Range(aTLC(Tbl)).CurrentRegion.Value
          bStarted = False
          For i = 2 To UBound(aData, 1)
            If aData(i, 1) = s Then
              If Not bStarted Then
                sBold = sBold & "," & Len(cmt) + 1 & "," & Len(aData(1, 2))
                bStarted = True
                cmt = cmt & vbLf & aData(1, 2)
              End If
              cmt = cmt & vbLf & aData(i, 2)
            End If
          Next i
        Next Tbl
        If Len(cmt) > 0 Then
          c.AddComment.Text Text:=Mid(cmt, 2)
          aBold = Split(sBold, ",")
          For i = 1 To UBound(aBold) Step 2
            c.Comment.Shape.TextFrame.Characters(aBold(i), aBold(i + 1)).Font.Bold = True
          Next i
          c.Comment.Shape.TextFrame.AutoSize = True
        End If
      End If
    Next c
  End If
End Sub

 

[Peter_SSs]

Great job, that works but now sometimes format of text is bold. Like on picture "Th" is normal and next "is That There" is bold, maybe I broke something

No, I don't think you broke anything - it's me. It is after midnight here now and I think my concentration isn't too good. It's another string reset!!

c.ClearComments
cmt = ""
sBold = ""
s = c.Text

And is there any posibility to run macro on one row only?

I'm going to bed now so I'll have to come back to this another time, but can you clarify exactly what you mean?

 

[Toomicek]

No, I don't think you broke anything - it's me. It is after midnight here now and I think my concentration isn't too good. It's another string reset!!

c.ClearComments
cmt = ""
sBold = ""
s = c.Text

I'm going to bed now so I'll have to come back to this another time, but can you clarify exactly what you mean?

I dont want to tire you so much If I change anything in input charts it recalculate all "subjects" and if there will be hundreds of these subjects it will calculate all night so I am asking if there is any posibility to make it on button or change only cells which are affected.

I want to change S1401 with text: NEW PRICE so it will change only S1401 with comment NEW PRICE. I guess it is too complicated

 

[Toomicek]

I changed how chart works and now I copy comments from sheet to another with this simple macro:

Sub copy1()Worksheets("Komentáře").Range("N:N").Copy
Worksheets("Přehled").Range("P:P").PasteSpecial Paste:=xlPasteComments
Application.CutCopyMode = False
Range("A1").Select
End Sub

Your macro works flawlessly even with reffered link (=Sheets1!A1). So i can work with comments on one sheet and only copy those comments to another. Its better because user dont worry about loading times

Thank you very much for your time!

 

[Peter_SSs]

Edit: I took quite a while composing this post so I hadn't seen the post above.
I'll leave this one though in case a re-visit is required later.

I dont want to tire you so much
I guess it is too complicated

You don't have to worry too much about that. You aren't paying me anything so I can quit any time if I feel like it. However, the reason we help on the forum is that we like doing it so generally there is not a problem.

If I change anything in input charts it recalculate all "subjects" and if there will be hundreds of these subjects it will calculate all night

That could well be so & we should be able to avoid that situation.
(It eventuated like that because when I started developing the code I based it on your initial screen shot which only had two comment cells. Also, as I knew no different at the time, it was those input cells that I was monitoring for change, not the tables.)

so I am asking if there is any posibility to make it on button or change only cells which are affected.

I want to change S1401 with text: NEW PRICE so it will change only S1401 with comment NEW PRICE.

I think that should be possible, but here you have given one example and in my mind (not knowing your actual sheet or how it will be used) I can think there may be other possibilities and things I need clarified so I can hopefully start with all the facts I need.

The following questions are aimed at the layout shown in this link you provided earlier.

1. When you mention changing to "NEW PRICE", can you confirm that such a change would be in column B &/or E &/or H?

2. If you did change the value beside S1338 in one of the tables, that would affect two of the cells in column J. Is that a real situation? That is, can a particular "Subject" appear in more than one cell in column J?

3. Do any of the column J entries get changed manually or by other code? If so, wouldn't that mean we had to monitor that range as well and re-build comments for those changed cells too?

4. Do any of the column A, D or G entries ever get changed?
If so ..

a) If, say, all the S1401 entries in the tables were changed to S1402 ..

i) What would happen to the main value in cell J5?
ii) What should happen to the comment in cell J5?

b) If, say, all the S1401 entries in the tables and the values beside them were deleted ..

i) What would happen to the main value in cell J5?
ii) What should happen to the comment in cell J5?

c) If cell A3 was changed to S1111, would that value automatically appear in column J by formula or other code? (Or perhaps all possible values for columns A, D & G actually already occur in column J in your real data?)


Lots of questions, & there will likely be more, but I am just trying to understand your circumstances as well as possible so I can develop the most effective solution that I can think of.

 

[Toomicek]

I've been playing around with your macro:

Private Sub Worksheet_Change(ByVal Target As Range)  Dim Changed As Range, c As Range
  Dim s As String, cmt As String, sBold As String
  Dim aTLC As Variant, aData As Variant, aBold As Variant
  Dim i As Long, Tbl As Long
  Dim bStarted As Boolean
  
  Const TopLeftCells As String = "A1 D1 G1 J1" '<- Top left cell of each table
  Const CommentCells As String = "N5:N200"  '<- Range to add/delete/edit comments
  
  Set Changed = Range(CommentCells)
  If Not Changed Is Nothing Then
    aTLC = Split(TopLeftCells)
    For Each c In Changed
      c.ClearComments
      s = c.Text
      cmt = ""
      sBold = ""
      If Len(s) > 0 Then
        For Tbl = 0 To UBound(aTLC)
          aData = Range(aTLC(Tbl)).CurrentRegion.Value
          bStarted = False
          For i = 2 To UBound(aData, 1)
            If aData(i, 1) = s Then
              If Not bStarted Then
                sBold = sBold & "," & Len(cmt) + 1 & "," & Len(aData(1, 2))
                bStarted = True
                cmt = cmt & vbLf & aData(1, 2)
              End If
              cmt = cmt & vbLf & aData(i, 2)
            End If
          Next i
        Next Tbl
        If Len(cmt) > 0 Then
          c.AddComment.Text Text:=Mid(cmt, 2)
          aBold = Split(sBold, ",")
          For i = 1 To UBound(aBold) Step 2
            c.Comment.Shape.TextFrame.Characters(aBold(i), aBold(i + 1)).Font.Bold = True
          Next i
          c.Comment.Shape.TextFrame.AutoSize = True
        End If
      End If
    Next c
  End If

And is there any posibility to run this macro with CALL function?

Sub A()
call commentmacro()
End sub

Like this?

I am testing to skip to one sheet with your sperb macro and run it than skip back to previous sheet. Of course without recognition for user (screenupdate = false/true).

Simple: Can you make ti to work with CALL function?


Thanks a lot!

 

[Peter_SSs]

Simple: Can you make ti to work with CALL function?

You should be able to do that by ..

1. Moving that Worksheet_Change code from the Worksheet Module to a Standard Module, and

2. Changing its first line from
Private Sub Worksheet_Change(ByVal Target As Range)

to

Sub commentmacro()

Note that it will then operate on the active sheet so you either have to make sure the correct sheet is active at the start of the code or the code would have to be modified a bit more to work on, say, a particular sheet name.

 

[Toomicek]

THANKS YOU ARE THE BEST!!!! It works perfect!!!

Some reputation or rewarding system on this forum?