DATA SORT REQUIRES IDENTICALLLY MERGED CELLS???? HELP PLEASE

[Guest]

TRYING TO DO A DATA SORT AND IT WON'T STATING IT REQUIRES IDENTICALLLY MERGED
CELLS.

 

[David Biddulph]

TRYING TO DO A DATA SORT AND IT WON'T STATING IT REQUIRES IDENTICALLLY
MERGED
CELLS.

a: Don't shout please.
b: That is one reason why if you read this group you will frequently see
the experts recommending *not* merging cells.

 

[Dennis]

David, I hope that I not too late,

Here is how I deal with merged cells in a worksheet. I expunge those
dastardly devils! If only people know how counterproductive merging
cells
is to future analysis and data handling.

First a sheet-level test for merged cells:

Sub SheetLevelTestForMergedCells()
'
' Do not try Cells.MergeCells = True or
' Cells.MergeCells = Null as they do not work
' in XL 2003 consistently
'
If Cells.MergeCells = False Then
MsgBox "not merged"
Else
MsgBox "Merged Cells"
End If

End Sub

******* NOW TO GET RID OF THEM ***************

Sub MergedCellsFindReset()

Dim myCell As Range
Dim resp As Long

For Each myCell In ActiveSheet.UsedRange.Cells
If myCell.MergeCells Then
If myCell.Address = myCell.MergeArea(1).Address Then
myCell.MergeArea.Select
resp = MsgBox(Prompt:="Found: " & myCell.MergeArea.Address & vbLf _
& "Continue looking?", Buttons:=vbYesNo)
If resp = vbNo Then
Exit Sub
End If
resp = MsgBox(Prompt:="RESET Found: " & _
myCell.MergeArea.Address & vbLf _
& "Reset Merged Cells?", Buttons:=vbYesNo)
If resp = vbYes Then
myCell.MergeArea.Select
With Selection
Select Case True
Case Selection.Rows.Count = 1 And Selection.Columns.Count > 1
If .WrapText = True Then .WrapText = False
' Seems that MergeCells = False must come before
' xlCenterAcrossSelection to work correctly
.MergeCells = False
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 38 ' Rose
Case Selection.Rows.Count > 1 And Selection.Columns.Count = 1
.MergeCells = False
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlTop
If .WrapText = False Then .WrapText = True
.Interior.ColorIndex = 38 ' Rose
End Select
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
End With
End If
End If
End If
Next myCell
MsgBox "Process Completed! Press OK to Continue"

End Sub