Merging two cells and separating data with symbol

Something like this in the Worksheet code

Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For c = 3 To 55 Step 2
    If Cells(4, c) Like "Tutor*" Then
        For r = 5 To 35
            v2 = Trim(Cells(r, c + 1).Value)
            v1 = Trim(Cells(r, c).Value)
            v1 = v1 & IIf(Len(v2) And Len(v1), "+", "")
            
            With Range(Cells(r, c).Address & ":" & Cells(r, c + 1).Address)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            If Len(v1) Or Len(v2) Then
                Cells(r, c) = v1 & v2
            End If
            DoEvents
        Next r
    End If
Next c
Range("AC:AD").EntireColumn.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Finished"

Originally Posted by ByteMarks

Something like this in the Worksheet code

Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
For c = 3 To 55 Step 2
    If Cells(4, c) Like "Tutor*" Then
        For r = 5 To 35
            v2 = Trim(Cells(r, c + 1).Value)
            v1 = Trim(Cells(r, c).Value)
            v1 = v1 & IIf(Len(v2) And Len(v1), "+", "")
            
            With Range(Cells(r, c).Address & ":" & Cells(r, c + 1).Address)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            If Len(v1) Or Len(v2) Then
                Cells(r, c) = v1 & v2
            End If
            DoEvents
        Next r
    End If
Next c
Range("AC:AD").EntireColumn.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Finished"

Thank you very much, ByteMarks!
It works perfectly! :D :D

Ho, ByteMarks!

Today I've tried your code in real file. It doesn't work because cells in row 4 contain real name, not "Tutor 1, 2, etc" (ad I wrote in first message).
I'm trying to modify it but I can't.
Suggestion, please?

Sorry.I missed that.
Try deleting the columns first and then just checking for something in row 4

Sub test()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Range("AC:AD").EntireColumn.Delete
For c = 3 To 53 Step 2
    If Len(Cells(4, c).Value) Then
        For r = 5 To 35
            v2 = Trim(Cells(r, c + 1).Value)
            v1 = Trim(Cells(r, c).Value)
            v1 = v1 & IIf(Len(v2) And Len(v1), "+", "")
            
            With Range(Cells(r, c).Address & ":" & Cells(r, c + 1).Address)
                .Merge
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
            End With
            
            If Len(v1) Or Len(v2) Then
                Cells(r, c) = v1 & v2
            End If
            DoEvents
        Next r
    End If
Next c
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Finished"

Hi, ByteMarks!
Don't worry, you've been precious again!
It works but I find another strange problem: if I copy the result of macro in a new file, cells are copied 2 by 2, not like a unique cell (I don't know if i'm clear).

I'm not noticing anything unusual if I copy the results to a new file.