Fixing Macro to Combine Contiguous Values - vba

Question

I'm creating a calendar right now based on months/quarters and I'm on the final steps and one of the last things I need to figure out is how to combine cells with duplicate values and merge them so they flow across the calendar fluidly.
What I have now:
What I want:
I'm a newbie VBA coder but have some experience with C# so I have been looking around and put together this code but I'm not sure if I got the logic right or if it even works properly:
Option Explicit
Public Sub MergeContiguousValues(col As Long)
Dim start As Range
Dim finish As Range
Set start = Cells(1, col)
Set finish = start
Application.DisplayAlerts = False
Do While start <> ""
Do While start = finish.Offset(1, 0)
Set finish = finish.Offset(1, 0)
Loop
If start.Address <> finish.Address Then
Range(start, finish).Merge
Range(start, finish).VerticalAlignment = xlCenter
End If
Set start = finish.Offset(1, 0)
Set finish = start
Loop
Application.DisplayAlerts = True
End Sub
Any suggestions on how to do this? Or where I'm going wrong?
I'm using =IF(ISNUMBER(FIND formulas for the calendar pulling information from separate sheets that carry data from an entry form.

Answer 1

I think this is what you're looking for. I tested it in a blank worksheet with the same value in cells A1 thru D1... Hope this helps!
Option Explicit
Public Sub MergeContiguousValues()
Dim start As Range
Dim finish As Range
Dim sVal As String
Dim fVal As String
'replace Cells(1, 1) with your passed variables
Set start = Cells(1, 1)
Set finish = start
'set values for the starting and finishing cell
sVal = start.Value
fVal = finish.Value
'check each column until the name is no longer the same
Do While sVal = fVal
Set finish = finish.Offset(0, 1)
fVal = finish.Value
Loop
'backup one column
Set finish = finish.Offset(0, -1)
'clear all values and only place value in start range
Range(start, finish).Value = ""
Range(start.Address).Value = sVal
'instead of merging, how about aligning across the start and finish range
Range(start, finish).HorizontalAlignment = xlCenterAcrossSelection
End Sub

Answer 2

I'd use the Areas property of Range object like follows:
Public Sub MergeContiguousValues(calendarColumns As Range, calendarStartRow As Long)
Dim i As Long
Dim area As Range
Application.DisplayAlerts = False
With calendarColumns
For i = calendarStartRow To LastRow(calendarColumns, calendarStartRow)
If WorksheetFunction.CountA(.Rows(i)) > 0 Then
For Each area In .Rows(i).SpecialCells(xlCellTypeFormulas).Areas
With area
.Merge
.VerticalAlignment = xlCenter
End With
Next area
End If
Next i
End With
Application.DisplayAlerts = True
End Sub
and here follows the LastRow() function:
Function LastRow(rng As Range, minRow As Long) As Long
With rng.Parent
With Intersect(.UsedRange, rng.columns).SpecialCells(xlCellTypeFormulas)
LastRow = .Areas(.Areas.Count).Row
End With
End With
If LastRow < minRow Then LastRow = minRow
End Function
as per your example a possible usage could be:
Sub main()
MergeContiguousValues Worksheets("calendar").Range("D:O"), 4
End Sub
where I assumed "calendar" as the name of the worksheet with the calendar: change it as per your needs