CODEWITHSUNDEEP
excelvbasorting
Ole Albers
Ole Albers

Reputation: 9305

Sorting in Excel keeping style?

I got an excel-file with alternating backgrounds for better readibility.

Row 1: White Background
Row 2: Gray Background
Row 3: White Backgrund
[...]

I use a VBA-Function to sort the contents of the Excel-File, the event is thrown by clicking a button:

Sub SortByName()
    ActiveSheet.Sort.SortFields.Clear
    ActiveSheet.Sort.SortFields.Add Key:=Range("BO6:BO1024"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveSheet.Sort.SortFields.Add Key:=Range("D6:D1024"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveSheet.Sort
        .SetRange Range("A6:DD1024")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

The sorting works fine just like I wanted to, but the Backgroundstyle is also moved with the content, which destroys the alternating style like:

Row 1: White (was row 3)
Row 2: White (was row 1)
Row 3: Gray  (was row 2)
[...]

Is there a way to sort the contents WITHOUT the styles being copied?

Upvotes: 3

Views: 1191

Answers (1)

Floris
Floris

Reputation: 46435

I admit this is a hack, the but the below will work. It's doing the "fix formatting" one cell at a time - presumably you can change this to do it for an entire row

Sub sortNoFormat()
Dim r As Range
Dim f()    ' a place to keep the formatting
Dim ii As Integer
Dim c

' set up the sort:
Set r = Range("tosort")
ActiveSheet.Sort.SortFields.Clear
ActiveSheet.Sort.SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

' before sorting, copy the format (color) of each cell to array f:
ReDim f(1 To r.Cells.Count)
ii = 1
For Each c In r.Cells
    f(ii) = c.Interior.ColorIndex
    ii = ii + 1
Next

' Perform the sort:
With ActiveSheet.Sort
    .SetRange r
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

' apply the old formatting:
ii = 1
For Each c In r.Cells
  c.Interior.ColorIndex = f(ii)
  ii = ii + 1
Next

End Sub

I trust that it is easy to see how you could create a couple of helper functions - formats = copyFormats(range) and pasteformats(range, formats) that would make the code more modular and readable. This would encapsulate some of the lines I added above in a simple wrapper so your original code just needs two lines (and the two functions in a helper module).

Upvotes: 2

Related Questions