VBA merge non-adjacent cells containing same text in Excel - vba

Question

I am building a calendar in Excel that automatically maps event information from a table to a dynamic calendar view. Each row represents a time from 8AM - 6PM, and each column represents a day of the week from Sunday - Saturday. I was able to map information for each unique event to two separate cells in each column, one for start time and one for end time. I am looking for help with building a macro to merge the cells containing the same information into one so the calendar is cohesive. E.g. Event A starts at 9AM and ends at 11AM. There is currently one cell populated at 9AM and one at 11AM, but the cell for 10AM is blank and I'd like to merge the two populated cells from the 9AM cell to 11AM cell. As the populated cells will not always be adjacent, the offset function doesn't seem to work in this case.
Here is the pseudo code I'm trying to accomplish:
For each column in a specified region
loop through each row
if two cells contain identical text
merge those two cells
Here is the little bit of code I've managed to come up with so far. You can tell there are many gaps and probably syntax errors:
Sub MergeCells
Dim cells As String
cells = ActiveSheet.Range("C8:V28,C31:V51,C54:V74,C77:V97,C100:V120")
If ActiveSheet.Range(cells).??? Then
ActiveSheet.Range(cells).Merge
End If
End Sub
Any help would be greatly appreciated!
Before picture
After picture

Answer 1

Okay - this may be overkill, and you may need to tweak, but this was fun to work on.
Sub combine_Same()
Application.DisplayAlerts = False
Dim tableRng As Range
Dim i As Long, k As Long, lastRow As Long
Dim curText As Range, prevText As Range
Dim tableRanges As Variant
tableRanges = Split("b3:e20,C31:V51,C54:V74,C77:V97,C100:V120", ",")
Dim rng As Long
For rng = LBound(tableRanges) To UBound(tableRanges)
Debug.Print "Working with: " & tableRanges(rng)
Set tableRng = Range(tableRanges(rng))
' tableRng.Select
lastRow = tableRng.Rows(tableRng.Rows.Count).Row
For k = tableRng.Columns(1).Column To tableRng.Columns.Count
For i = lastRow To tableRng.Rows(1).Row Step -1
Set curText = Cells(i, k)
Set prevText = curText.End(xlUp)
If curText.Value = prevText.Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, prevText).Merge
curText.VerticalAlignment = xlCenter
ElseIf curText.Value = curText.Offset(-1, 0).Value And Not IsEmpty(curText) Then
'curText.Select
Range(curText, curText.Offset(-1, 0)).Merge
curText.VerticalAlignment = xlCenter
End If
Next i
Next k
Next rng
Application.DisplayAlerts = True
End Sub