CODEWITHSUNDEEP
vbaexcelexcel-2013
A Cohen
A Cohen

Reputation: 456

VBA - Sorting cells referencing MergeArea

I am running into an issue with my sorting code. My goal is to sort area by address type. Each person has multiple accounts and there name is in a merged area that goes as long as there are accounts. So from "B3:B6" is merged for the first one.

However, sometimes these people have different addresses under each account. So, i'd like to sort each area, in this example "C3:H6" by the values in Column E. But, when I run through line-by-line, it doesn't execute it.

CODE:

With NeedMail
    rwCnt = .Cells(Rows.Count, 1).End(xlUp).Row
    For y = 3 To rwCnt
        If .Cells(y, 2).MergeCells Then
            Set mrg = .Range(.Cells(y, 2).MergeArea.Address)
            Set srt = .Range(mrg.Offset(0, 1).Address & ":" & mrg.Offset(0, 6).Address)
            Set keyRng = .Range(mrg.Offset(0, 3).Address)
            cnt = .Cells(y, 2).MergeArea.Rows.Count
            Z = y + cnt - 1

            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=keyRng, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            With .Sort
                .SetRange srt
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With

            mrg.UnMerge

        'More code to execute here

        End If
    Next y
End With

SAMPLE DATA:

SAMPLE DATA

Thank you in advance, I've been racking my brain trying to figure what is wrong?

Upvotes: 0

Views: 67

Answers (1)

BigBen
BigBen

Reputation: 49998

When you offset mrg, e.g. Set srt = .Range(mrg.Offset(0, 1)..., your newly offset range is only 1 row high. So Resize the number of rows using cnt.

Also, once you have srt, you can just use srt.Sort. Here's revised code showing that simplified sort.

Sub SortWhenMerged()
    Dim needMail As Worksheet
    Dim rwCnt As Long, y As Long, cnt As Long
    Dim mrg As Range, srt As Range, keyRng As Range

    Set needMail = ThisWorkbook.Worksheets("NeedMail")
    With needMail
        rwCnt = .Cells(.Rows.Count, 1).End(xlUp).row

        For y = 3 To rwCnt
            If .Cells(y, 2).MergeCells Then

                Set mrg = .Cells(y, 2).MergeArea
                cnt = mrg.Rows.Count

                Set srt = mrg.Offset(, 1).Resize(cnt, 6)
                Set keyRng = mrg.Offset(, 3).Resize(cnt)

                srt.Sort Key1:=keyRng, Order1:=xlAscending, Header:=xlNo, Orientation:=xlTopToBottom, SortMethod:=xlPinYin

                mrg.UnMerge
            End If
        Next y
    End With

End Sub

Upvotes: 1

Related Questions