CODEWITHSUNDEEP
excelvba
Philip Gruber
Philip Gruber

Reputation: 33

Create comments to a range of cells ftom the values of another range of cells

I want to create comments to a range of cells. The comments should contain the values of another range of cells.

Here is what I have so far:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sResult As String

If Union(Target, Range("A18")).Address = Target.Address Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    sResult = "Maximal " & Target.Value

    With Range("I6")
        .ClearComments
        .AddComment
        .Comment.Text Text:=sResult
    End With
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End If
End Sub

This works for one cell. I need this for a range of cells. For example, let's say I need the values of cells A1:F20 in comments of cells A21:F40. I do not want to copy the same Sub as many times.

Upvotes: 2

Views: 18147

Answers (3)

Philip Gruber
Philip Gruber

Reputation: 33

I made some adaptions to your advices, thanks a lot, this solved my problem:

Private Sub Worksheet_Change(ByVal target As Range)


Dim src As Range: Set src = Worksheets("maxleft").Range("C2:K11")
Dim tar As Range: Set tar = Range("I6:Q15")

    For i = 0 To tar.Rows.Count - 1
        For j = 0 To tar.Columns.Count - 1
        Dim sResult As String
        sResult = "Maximal " & Worksheets("maxleft").Cells(src.Row + i, src.Column + j)
        With Cells(tar.Row + i, tar.Column + j)
            .ClearComments
            .AddComment
            .Comment.Text Text:=sResult
        End With
        Next j
    Next i

End Sub

Upvotes: 1

Amen Jlili
Amen Jlili

Reputation: 1944

It should do you the job if you replace

With Range("I6")
        .ClearComments
        .AddComment
        .Comment.Text Text:=sResult
    End With

with

    For Each cell In Range("A1", "F20").Cells
    Dim V As Range
    Set V = cell.Offset(20, 0)
    With cell
    .ClearComments
    If Not IsEmpty(V) Then
    .AddComment V.Value
    End If
    End With
   Next

This will basically ignore all empty cells.

Output:

enter image description here

My code:

Sub TEST()
 For Each cell In Range("A1", "F20").Cells
    Dim V As Range
    Set V = cell.Offset(20, 0)
    With cell
    .ClearComments
    If Not IsEmpty(V) Then
    .AddComment V.Value
    End If
    End With
   Next
End Sub

Upvotes: 1

PommesKlaus
PommesKlaus

Reputation: 1

From your question I understand that you want to select a range of cells (e.g. "A1:A5"), then select another range of cells (e.g. "B6:B10") and the respective values of the first selected Range should be placed as comments in the secon selected Range. Is this correct?

The following code checks if 2 ranges with an equal length are selected and copies the values of the first selected range as comments to the second selected range:

Private Sub Worksheet_SelectionChange(ByVal target As Range)

If InStr(target.Address, ",") Then
    Dim selected_range() As String
    selected_range = Split(target.Address, ",")

    If Range(selected_range(0)).Rows.Count = Range(selected_range(1)).Rows.Count Then
        Dim src As Range: Set src = Range(selected_range(0))
        Dim tar As Range: Set tar = Range(selected_range(1))

        For i = 0 To src.Rows.Count - 1
            Dim sResult As String
            sResult = "Maximal " & Cells(src.Row + i, src.Column)
            With Cells(tar.Row + i, tar.Column)
                .ClearComments
                .AddComment
                .Comment.Text Text:=sResult
            End With
        Next i
    End If
End If
End Sub

Upvotes: 0

Related Questions