"Re-Merging" Cells

[Carrie_Loos via OfficeKB.com]

I currently have this code that someone helped me with. It is a spreadsheet
that has several merged cells on it to indicate a time block. In order to
pick up a start and end date of the time block I start with a 1 and end with
a 2. Then the code goes through and merges all cells in columns next to each
other containing a 1. Can anyone tell me how to change the VB to include the
2 as well?

Sub MergeCells()
Dim RowCount As Variant
Dim ColCount As Variant

' This macro looks for cells that contain "1" and merges them on the
Caldendar sheet

Range("B8").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="#REF!", Replacement:="0", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Range("A8").Select
Do Until ActiveCell = ""

ActiveCell.Activate
RowCount = ActiveCell.Row

ColCount = 1

Do While Cells(RowCount, ColCount) <> ""

If Cells(RowCount, ColCount) = 1 Then

StartCol = ColCount
Data = 1

Do While Cells(RowCount, ColCount) = 1 And _
Cells(RowCount, (ColCount + 1)) = 1

ColCount = ColCount + 1
Data = Data & " 1"

Loop

Application.DisplayAlerts = False
Range(Cells(RowCount, StartCol), _
Cells(RowCount, ColCount)). _
MergeCells = True
Cells(RowCount, StartCol) = Data
Application.DisplayAlerts = True


End If

ColCount = ColCount + 1
Loop

ActiveCell.Offset(1, 0).Activate

Loop

Range("B8").Select
Call Fill_In_Training_Blocks

End Sub

I am sure it is something really simple, I just don' t know how.

Thanks
Carrie