i need to find a way of editing a section of comment text. i have most of the code figured out already. my macro button takes the info contained in the first few columns of one row in the active sheet and compiles this info into a comment for a found cell in sheet1. sometimes the info in the active sheet will be updated and will need to replace the info of the comment in sheet1. my only problem is that i need to be able to replace a section of text in a comment with a vba macro, not the whole comment. the start of the text to be replaced will always be the text in column A of the active sheet. the end of the text to be replaced is a number but it can be one or two digits long and is from column G in the active sheet. this number can be anywhere from 1 to 50 ish and will always be preceded by Children. example: "Children 15" or "Children 4". i was thinking maybe using the word Children to find the numeric characters after, but i don't know how to do this. anybody have any ideas? thanks.
Code:
Sub setComment4Tour()
On Error GoTo hell
Dim wrow As Range
Dim id, AC As String
Dim SearchRange As Range
Dim wcol As Range
Dim fdate As Date
Dim fcell As Range
If Not Intersect(ActiveCell, Range("aa:aa")) Is Nothing Then
' check for current sheet activecell value in other sheet range
If Range("A" & ActiveCell.Row) <> "" And Range("C" & ActiveCell.Row) <> "" Then
' check for values in current sheet col A & C
id = ActiveCell.Value
fdate = Range("C" & ActiveCell.Row).Value
' Find row ref
Set wrow = Worksheets("WEEKLY").Range("a4:a13").Find(id, lookat:=xlPart)
If Not wrow Is Nothing Then
End If
' Find column ref
Set SearchRange = Worksheets("WEEKLY").Range("3:3")
Set wcol = SearchRange.Find(fdate, LookIn:=xlValues, lookat:=xlWhole)
Set fcell = Worksheets("WEEKLY").Cells(wrow.Row, wcol.Column)
' combine row and column to get target cell
If Not InStr(UCase(fcell), "TOUR") <> 0 Then
mb1 = MsgBox("The WEEKLY does not have a tour scheduled for " & id & "." & Chr(10) & "Would you like to create the info comment for " & id & " anyway?", vbYesNo, " Tour Not Found!")
If mb1 = vbYes Then
GoTo updateComment
' Resume Next
Else
GoTo hell
End If
End If
' MsgBox "cell " & fcell.Address
updateComment:
' new comment based on current sheet info in the activecell row
newcmnt = Range("A" & ActiveCell.Row).Value & Chr(10) & Range("D" & ActiveCell.Row).Value & "-" & Range("E" & ActiveCell.Row).Value & Chr(10) & "Adults " & Range("F" & ActiveCell.Row).Value & Chr(10) & "Children " & Range("G" & ActiveCell.Row).Value
If fcell.Comment Is Nothing Then
' Set ctext = Worksheets("WEEKLY").Cells(wrow.row, wcol.Column).Comment
' fcell.Comment.Text Text:=atext
fcell.AddComment Text:=newcmnt
fcell.Comment.Shape.TextFrame.AutoSize = True
MsgBox "comment added"
ElseIf InStr(fcell.Comment.Text, Range("A" & ActiveCell.Row).Value) <> 0 Then
' check if comment title already exists
MsgBox "Tour " & Range("A" & ActiveCell.Row).Value & "'s info comment already exists on the WEEKLY."
Else
' ammend current comment with additional comment
cmnt = fcell.Comment.Text
newcmnt = cmnt & Chr(10) & Chr(10) & Range("A" & ActiveCell.Row).Value & Chr(10) & Range("D" & ActiveCell.Row).Value & "-" & Range("E" & ActiveCell.Row).Value & Chr(10) & "Adults " & Range("F" & ActiveCell.Row).Value & Chr(10) & "Children " & Range("G" & ActiveCell.Row).Value
fcell.Comment.Text Text:=newcmnt
fcell.Comment.Shape.TextFrame.AutoSize = True
MsgBox "comment added"
End If
Else
MsgBox "There is not a Tour or Date on this Row."
GoTo hell
End If
Else
MsgBox "Select the cell with the Aircraft that you would like to create a Comment for, and try again."
End If
Exit Sub
hell:
' MsgBox "No Comment"
End Sub
Last edited by a moderator:
