Merge range of cells offset to target - excel

Question

I have a worksheet where Appt Note text is very lengthy. I need to place it in a row of nine merged cells.
I'm trying to check all the cells in column A for the value "Appt Note:" then merge the nine cells to the right of it so all my data shows up in a viewable format.
I checked lots of posts online but can't put my particular code together. I've built it, with the exception of the merge.
Sub MergeTest()
Dim cel As Range
Dim WS As Worksheet
For Each WS In Worksheets
For Each cel In WS.Range("$A1:$A15")
If InStr(1, cel.Value, "Appt Note:") > 0 Then Range(cel.Offset(1, 9)).Merge
Next
Next
End Sub

Answer 1

As per my comment, hereby a sample of Range.Find where in this case I assume "Appt Note:" only exists once per sheet:
Sub Test()
Dim ws As Worksheet
Dim cl As Range
For Each ws In ThisWorkbook.Worksheets
Set cl = ws.Range("A:A").Find(What:="Appt Note:", Lookat:=xlPart)
If Not cl Is Nothing Then
cl.Offset(0, 1).Resize(1, 9).Merge
End If
Next
End Sub
Note: Merged cells are VBA's worst nightmare! Try to stay away from them. Maybe you can let the text just overflow?
Edit: In case your value could exist multiple times, use Range.FindNext:
Sub Test()
Dim ws As Worksheet
Dim cl As Range
Dim rw As Long
For Each ws In ThisWorkbook.Worksheets
Set cl = ws.Range("A:A").Find(What:="Appt Note:", Lookat:=xlPart)
If Not cl Is Nothing Then
rw = cl.Row
Do
cl.Offset(0, 1).Resize(1, 9).Merge
Set cl = ws.Range("A:A").FindNext(cl)
If cl Is Nothing Then
GoTo DoneFinding
End If
Loop While cl.Row <> rw
End If
DoneFinding:
Next
End Sub

Answer 2

Sub MergeTest()
Dim ws As Worksheet, cell As Range
For Each ws In ThisWorkbook.Worksheets
For Each cell In ws.Range("A1:A15")
If cell.Value Like "Appt Note:*" Then cell.Resize(1, 9).Merge
Next
Next
End Sub
ThisWorkbook refers to the workbook where the VBA code is, to avoid issues when a different workbook is active. The Like operator can be used to check if the cell value matches a wildcard pattern.
cell.Resize(1, 9) can be used to get a new range starting from cell and resized to 9 columns.

Answer 3

I found code that will do what I need. See below. I've tested it and it works. It will start at the bottom of my spreadsheet and find the last row with data and work it's way up until it reaches my first row.
Thanks so much for all your help! If you have any suggestions, advice, warnings, etc regarding the code below, please share. As I said, I am completely new to VB and know just enough to be dangerous. So I can use all the help I can get. :)
Sub mergeCellsBasedOnCriteria()
Dim myFirstRow As Long
Dim myLastRow As Long
Dim myCriteriaColumn As Long
Dim myFirstColumn As Long
Dim myLastColumn As Long
Dim myWorksheet As Worksheet
Dim myCriteria As String
Dim iCounter As Long
myFirstRow = 1
myCriteriaColumn = 1
myFirstColumn = 2
myLastColumn = 10
myCriteria = "Appt Note:"
Set myWorksheet = Worksheets("Sample")
With myWorksheet
myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For iCounter = myLastRow To myFirstRow Step -1
If .Cells(iCounter, myCriteriaColumn).Value = myCriteria Then
.Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).Merge
.Range(.Cells(iCounter, myFirstColumn), .Cells(iCounter, myLastColumn)).WrapText = True
End If
Next iCounter
End With
End Sub