Excel VBA - Incremental Check and Merge - excel

Question

OK so here I go with my first question, advance apologies for any ambiguities.
I am working on a sheet where I pull data through SQL, and copy it to a certain table. The data contains string value. I am currently using vba to pull data (as there are variable involved), and copy it to grid how I want it.
The problem comes here; after I have copied the data, I have to merge certain Cells (sometimes two sometimes 3), and I do this manually. The condition is if C13 = C14 then merge, and if I merge C13 and C14 I have to merge B13 and B14 as well, and D13 and D14 as well. Next I want to check if the merged cell (which is now C13) is equal to C15, and then merge C13 to C15, and if this condition is true then B & D are also going to be merged.
If the condition of C13 is not true i.e. C13 <> C14 I want to go to next cell C14 and check if C14 = C15 or not.
I want to do this with vba, but trying to do this manually, will run into miles and miles of codes can someone please help?
This is the start of the code I have found here and managed to change a bit but now I am lost
Sub Merge()
Dim k As Range, cell As Range, name As String
Set k = Range("C13:C50")
For Each cell In k
If cell.Value =
End If
Next
End Sub

Answer 1

I could propose you the following code:
Sub Merge()
Dim k As Range, cell As Range, name As String
Set k = Range("C13:C50")
Application.DisplayAlerts = False
Do_it_again:
For Each cell In k
If cell.Value = cell.Offset(1, 0).Value _
And IsEmpty(cell) = False Then
Debug.Print cell.Address
'for column C
Range(cell, cell.Offset(1, 0)).Merge
'for column B
cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
'for column D
cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
GoTo Do_it_again
End If
Next
Application.DisplayAlerts = True
End Sub
I don't necessary like the code I proposed but after all it works as presented below.
Edit to improve efficiency
I have to admit that previous code wasn't efficient for big data table, like 5000 rows or more. One below is 90% faster but still need approx 10-20 sec for 5000 rows of data.
Most important changes compared to the code above are marked *****.
Sub Merge()
Dim k As Range, cell As Range, name As String
Dim kStart As Range, kEnd As Range '*****
Set kStart = Range("C13") '*****
Set kEnd = Range("C8000") '*****
Application.DisplayAlerts = False
Application.ScreenUpdating = False '*****
Do_it_again:
For Each cell In Range(kStart, kEnd) '*****
If cell.Value = cell.Offset(1, 0).Value _
And IsEmpty(cell) = False Then
Application.StatusBar = cell.Address '***** check progress in Excel status bar
'for column C
Range(cell, cell.Offset(1, 0)).Merge
'for column B
cell.Offset(0, -1).Resize(cell.MergeArea.Rows.Count, 1).Merge
'for column D
cell.Offset(0, 1).Resize(cell.MergeArea.Rows.Count, 1).Merge
Set kStart = cell '*****
GoTo Do_it_again
End If
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True '*****
End Sub

Answer 2

Sorry, forgot to initialize count # 14
current = cells(13,3)
count = 14
for i = 14 to 15
next = cells(i,3)
If current = next then
'match encountered, merge columns B,C,D
for j = 2 to 4
cells(13,j) = cells(13,j) & cells(count,j)
next j
count = count + 1
end if
next i
If you are not trying to append but replace the value of C13 with C14 if matched, and C13 with C15 if matched etc..., then change the line
cells(13,j) = cells(13,j) & cells(count,j)
to
cells(13,j) = cells(count,j)