Excel Macro Merge Cells Based on Other Merge - vba

Question

I need to do merge and center for over 7,000+ rows. There are 3 columns of the numerous columns that will have data that can be merged. I cannot delete rows. I took a small snippet below to hopefully demonstrate this.
I utilized this macro that I found to merge row A. It works great. The issue is that Column B and C were merging differently. I need the merging to be based on how Column A merged. Column A is unique, it never repeats. Column B and C may repeat so merging must be based on column A.
Code that was used to merge column A:
Sub MergeSameCell()
'Updateby20131127
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
For i = 1 To xRows - 1
For j = i + 1 To xRows
If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
Exit For
End If
Next
WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
i = j - 1
Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
This allowed me to merge unique codes in column A (over 7000 rows). The next thing I need is to merge the two columns to the right of it based on the merging of the column A.
Example: I need column B & C to be merged based on Column A. I can't do the merge macro listed above that I did for column A because the '50' in column B merges across Column A (01, 02, 03). Instead, I need each to be merged in order regardless of what the next group's value is.
What I have:
What I need:
Any help would be appreciated!

Answer 1

I determined the answer. I will post it here in case someone else faces this issue. I tweaked the original code and saved it in the Macro. Before doing any sorting, Select all rows of column A, then hit F5 to run....
Sub MergeSameCell()
'Updateby20131127
Dim Rng As Range, xCell As Range
Dim xRows As Integer
xTitleId = "Multiple Merge & Center"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address,
Type:=8)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xRows = WorkRng.Rows.Count
For Each Rng In WorkRng.Columns
For i = 1 To xRows - 1
For j = i + 1 To xRows
If Rng.Cells(i, 1).Value <> Rng.Cells(j, 1).Value Then
Exit For
ElseIf Rng.Cells(i, 1).Value = "" Then
Exit For
End If
Next
WorkRng.Parent.Range(Rng.Cells(i, 1), Rng.Cells(j - 1, 1)).Merge
WorkRng.Parent.Range(Rng.Cells(i, 2), Rng.Cells(j - 1, 2)).Merge
WorkRng.Parent.Range(Rng.Cells(i, 3), Rng.Cells(j - 1, 3)).Merge
i = j - 1
Next
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub