Sort Merged Cells

[Jeet_Dhillon]

Friends , I am trying to Sort a Sheet but Cells are merged , i was able to record a Macro by Manually Unmerge Cells and then Merge , But this whole Process takes time and Lag.
Any Suggestions to Tune up this Code .

Thanks


"Private Sub Repairsort_Click()
RepairSort.BackColor = 9434879


Range("D30:Q64").Select
Selection.UnMerge
Range("B30:T64").Select
ActiveWorkbook.Worksheets("Forepersons Report").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Forepersons Report").Sort.SortFields.Add Key:= _
Range("B30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Forepersons Report").Sort
.SetRange Range("B30:T64")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D30:F64").Select
Selection.Merge True
Range("G30:Q64").Select
Selection.Merge True
Range("G47:Q47").Select



End Sub"

 

[jasonb75]

Instead of merging cells, you could just use wider columns and avoid the problem.

 

[Jeet_Dhillon]

Not Possible because of Layout of Sheet .

Instead of merging cells, you could just use wider columns and avoid the problem.

 

[Michael M]

Not much you can do with Merged cells....avoid them at any cost !!
But try

Private Sub Repairsort_Click()
Application.ScreenUpdating = False
RepairSort.BackColor = 9434879
Range("D30:Q64").UnMerge
Range("B30:T64").Select
Worksheets("Forepersons Report").Sort.SortFields.Clear
Worksheets("Forepersons Report").Sort.SortFields.Add Key:= _
Range("B30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With Worksheets("Forepersons Report").Sort
.SetRange Range("B30:T64")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D30:F64").Merge True
Range("G30:Q64").Merge True
Range("G47:Q47").Select
Application.ScreenUpdating = True
End Sub

 

[Jeet_Dhillon]

This Solved my Problem .
Thanks ALot

Not much you can do with Merged cells....avoid them at any cost !!
But try

Private Sub Repairsort_Click()
Application.ScreenUpdating = False
RepairSort.BackColor = 9434879
Range("D30:Q64").UnMerge
Range("B30:T64").Select
Worksheets("Forepersons Report").Sort.SortFields.Clear
Worksheets("Forepersons Report").Sort.SortFields.Add Key:= _
Range("B30"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With Worksheets("Forepersons Report").Sort
.SetRange Range("B30:T64")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("D30:F64").Merge True
Range("G30:Q64").Merge True
Range("G47:Q47").Select
Application.ScreenUpdating = True
End Sub

 

[Michael M]

Glad that helped..

 

[jasonb75]

Not Possible because of Layout of Sheet .

In that case, how about formatting the cells as 'Centre across selection' as an alternative to 'Merge and centre'?

The appearance should be the same if done correctly, and it should avoid the issues with sorting.