[a_axe]

Но в моем коде уже используется эта функция при добавлении комментариев в другой диапазон ячеек, из-за чего я получаю ошибку: ambiguous name detected Worksheet_Change »

Функция автоматически вызывается при изменении ячеек рабочего листа, а у вас таких функций две. Соответственно, такого быть не должно быть, о чем и указано в ошибке (даже в теории непонятно - какую нужно запускать, если обе - то какую первой, какую второй).

Сведите содержимое ваших функций в одну общую:

Пример кода

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A1:A666")) Is Nothing Then
   If Target <> 0 Then
     Call CreateHypelinkInTextCell
   End If
 End If
 Dim NewCellValue$, OldComment$
Dim cell As Range
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Intersect(Target, Range("C2:C666")) Is Nothing Then Exit Sub
    'перебираем все ячейки в измененной области
    For Each cell In Intersect(Target, Range("C2:C666"))
        If IsEmpty(cell) Then
            NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки
        Else
            NewCellValue = cell.Formula     'или ее содержимое
        End If
        On Error Resume Next
        With cell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     'удаляем старое примечание (если было)
            .AddComment         'добавляем новое и вводим в него текст
            .Comment.Text Text:=OldComment & Application.UserName & " " & _
                            Format(Now, "MM.DD.YY h:MM:ss") & ": " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True    'делаем автоподбор размера
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell
 
End Sub

[pedrosoft]

a_axe, спасибо это работает! А можете подсказать как мне вообще отказаться от функции CreateHypelinkInTextCell и перенести ее функционал в:

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, Range("A1:A666")) Is Nothing Then
   If Target <> "" Then
     Call CreateHypelinkInTextCell
   End If
 End If

[a_axe]

pedrosoft, попробуйте такой вариант:

Скрытый текст

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim iCell As Range, iText$
 If Not Intersect(Target, Range("A1:A666")) Is Nothing Then
   If Target <> 0 Then
     For Each iCell In [A2:A666]
        iText = iCell.Text
        If iText <> "" Then iCell.Hyperlinks.Add iCell, ("https://test.ru/issues/" & iText)
    Next
   End If
 End If
 Dim NewCellValue$, OldComment$
Dim cell As Range
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Intersect(Target, Range("C2:C666")) Is Nothing Then Exit Sub
    'перебираем все ячейки в измененной области
    For Each cell In Intersect(Target, Range("C2:C666"))
        If IsEmpty(cell) Then
            NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки
        Else
            NewCellValue = cell.Formula     'или ее содержимое
        End If
        On Error Resume Next
        With cell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete     'удаляем старое примечание (если было)
            .AddComment         'добавляем новое и вводим в него текст
            .Comment.Text Text:=OldComment & Application.UserName & " " & _
                            Format(Now, "MM.DD.YY h:MM:ss") & ": " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True    'делаем автоподбор размера
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next cell
 
End Sub

[pedrosoft]

Работает, спасибо!

[Iska]

Оффтопиком:

If Target <> 0 Then »

If Target <> "" Then »

Код:

If Not Target Is Nothing Then

[pedrosoft]

Я добавил новую функциональность в виде переноса строки в другой лист (Archive.TEST), после появления в ячейки значения "Решена":

Код:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim iText$
    Dim iCell As Range
    'если ячейка в отслеживаемом диапазоне, то продолжаем
    If Not Intersect(Target, Range("A2:A666")) Is Nothing Then
        'перебираем все ячейки в измененной области
        For Each iCell In Intersect(Target, Range("A2:A666"))
            iText = iCell.Text
            If iText <> "" Then iCell.Hyperlinks.Add iCell, ("https://test.ru/issues/" & iText)
        Next
    End If

    Set trgt_rng = Range([D2], [D2].End(xlDown))
    If Not Intersect(trgt_rng, Target) Is Nothing And Target.Cells(1).Value = "Решена" Then
        Set out_rng = Worksheets("Archive.TEST").[A1].Offset(Cells.Rows.Count - 1).End(xlUp).Offset(1)
        Target.EntireRow.Copy out_rng
        Target.EntireRow.Delete
        Application.CutCopyMode = False
    End If

    Dim NewCellValue$, OldComment$
    Dim bCell As Range
    'если ячейка не в отслеживаемом диапазоне, то выходим
    If Intersect(Target, Range("C2:C666")) Is Nothing Then Exit Sub
    'перебираем все ячейки в измененной области
    For Each bCell In Intersect(Target, Range("C2:C666"))
        If IsEmpty(bCell) Then
            NewCellValue = "Ячейка очищена" 'фиксируем очистку ячейки
        Else
            NewCellValue = bCell.Formula 'или ее содержимое
        End If
        On Error Resume Next
        With bCell
            OldComment = .Comment.Text & Chr(10)
            .Comment.Delete 'удаляем старое примечание (если было)
            .AddComment 'добавляем новое и вводим в него текст
            .Comment.Text Text:=OldComment & Application.UserName & " " & Format(Now, "MM.DD.YY h:MM") & ": " & NewCellValue
            .Comment.Shape.TextFrame.AutoSize = True 'делаем автоподбор размера
            .Comment.Shape.TextFrame.Characters.Font.Size = 8
        End With
    Next bCell
End Sub

Но при работе макроса получаю ошибку в строке:

Код:

If Intersect(Target, Range("C2:C666")) Is Nothing Then Exit Sub

Подскажите почему этой проверке не нравиться, как я делаю Target.EntireRow.Delete

[Iska]

pedrosoft, упакуйте Вашу Рабочую книгу с кодом и содержанием в архив и выложите последний сюда. Укажите, как именно воспроизвести данную ошибку.

[pedrosoft]

Когда выставляю в строке статус "Решена" вываливается дебагер, после завершения дебагера строка переноситься на архивный лист, но в основном листе все равно остается примечание

[Iska]

Во-первых, возьмите в привычку объявлять все переменные и пользовать инструкцию Option Explicit. Во-вторых, если Вы пользуете On Error Resume Next, обрабатывайте возможные ошибки.

Ошибка у Вас возникает после второго вызова процедуры Worksheet_Change(), каковой происходит после этого:

Скрытый текст

и возврата из неё в первый вызов.

К моменту ошибки Target из первого вызова уже ссылается на более не существующий объект Рабочего листа.