Option Explicit
Sub Demo()
Dim objDic As Object, rngData As Range
Dim i As Long, sKey, c As Range, arrData
Set objDic = CreateObject("scripting.dictionary")
Set rngData = Range("C1").CurrentRegion
' load data into an array
arrData = rngData.Value
For i = LBound(arrData) To UBound(arrData)
    sKey = arrData(i, 3)
    ' get merged range with Dict object
    If objDic.exists(sKey) Then
        Set objDic(sKey) = Union(objDic(sKey), Cells(i, 8))
    Else
        Set objDic(sKey) = Cells(i, 8)
    End If
Next i
' merge range on Col B
Application.DisplayAlerts = False
For Each sKey In objDic.Keys
    Set c = objDic(sKey)
    If c.Cells.Count > 1 Then
        c.Merge
    End If
Next
Application.DisplayAlerts = True
End Sub