简体   繁体   中英

VBA Function to insert comment based on offset cell value

I have two worksheets. One is a long term plan calendar, with dates on the top and objects on the left. The other worksheet is the data sheet. Each calendar entry is its own row, and there's one column that has the cell address of the calendar entry for the other sheet. I'm trying to add comments to the calendar worksheet, but am getting an error with the below code. Any suggestions as to what I am doing wrong? Thanks!

Sub UpdateLTP()

    Sheets("Long Term Plan").Select
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearComments
    Range("A1").Select

    Sheets("Data").Select
    Dim rng As Range, cell As Range
    Set rng = Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
    For Each cell In rng
        If cell.Value <> "" Then
            Sheets("Long Term Plan").Range(cell.Value).AddComment cell.Offset(0, -1).Value
        End If
    Next cell

End Sub

This works to create a comment and then add the text to the comment. The code will error out if the value of the offset cell is nothing. Adding some error checking would prevent that from happening

Sub UpdateLTP()

Dim xlRange As Range
Dim xlCell As Range

    Sheets("Long Term Plan").Select
    Set xlRange = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    xlRange.ClearComments
    Sheets("Data").Select
    Set xlRange = Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
    For Each xlCell In xlRange
        If xlCell.Value <> "" Then
            With Sheets("Long Term Plan").Range(xlCell.Value)
                .AddComment
                .Comment.Visible = False
                .Comment.Text Text:=xlCell.Offset(0, -1).Value
            End With
        End If
    Next xlCell

End Sub

This code has a check to make sure that the offset cell is not empty

Sub UpdateLTP()

Dim xlRange As Range
Dim xlCell As Range

    Sheets("Long Term Plan").Select
    Set xlRange = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
    xlRange.ClearComments
    Sheets("Data").Select
    Set xlRange = Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
    For Each xlCell In xlRange
        If xlCell.Value <> "" Then
            If xlCell.Offset(0, -1).Value <> "" Then
                With Sheets("Long Term Plan").Range(xlCell.Value)
                    .AddComment
                    .Comment.Visible = False
                    .Comment.Text Text:=xlCell.Offset(0, -1).Value
                End With
            End If
        End If
    Next xlCell

End Sub

Please use this code. I hope you can get by without an explanation as the code is pretty simple and the difference will help you spot where the errors came to be. I've tested the below code and it works fine. Hope this helps.

Option Explicit
Sub UpdateLTP()
Dim xlCell, xlRange, SourceRange As Range
Dim rowCount As Integer
Set SourceRange = Sheets("Data").Range("AA2:AA" & Range("AA" & Rows.Count).End(xlUp).Row)
    For Each xlCell In SourceRange
        If xlCell.Value <> "" Then
            If xlCell.Offset(0, -1).Value <> "" Then
                With Sheets("Long Term Plan").Cells(xlCell.Row, xlCell.Column)
                    '' Clear Comments as needed from our source sheet.
                    .ClearComments
                    .AddComment (CStr(xlCell.Offset(0, -1).Value))
                    '' Please change to false as needed.
                    .Comment.Visible = True
                End With
            End If
        End If
    Next xlCell
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM