Sortera celler efter färg

Sortera celler efter färg

Här i detta tips belyses hur vi kan sortera ett cellområde utifrån färgerna cellerna har.

Detta kan t ex komma väl till användning i kombination med Datavalidering.

Option Explicit

Sub Sortera_Efter_Färg()
Dim stStartCell As String
Dim stSlutcell As String
Dim rgSortera As Range
Dim rnCell As Range

'Felhanteringsrutin
On Error GoTo SorteraEfterFärg_Err

Application.ScreenUpdating = False

'Här skapas dialogrutan för att ta emot celladressen
'till den första cellen i sorteringsområdet.
stStartCell = InputBox("Ange den celladress som utgör " & _
"den vänstra cellen högst upp i det område som ska sorteras, " & Chr(13) & "t ex A1.", "Sortering efter färg")

If stStartCell <> "" Then
'Här väljs cellområdet som ska sorteras. Noterbart är
'markeringens omfattning (xlDown).
    stSlutcell = Range(stStartCell).End(xlDown).Address
'En temporär kolumn skapas för att placera färgernas
'indexnummer i och där varje cells färg läses in.
    Range(stStartCell).EntireColumn.Insert
    Set rgSortera = Range(stStartCell, stSlutcell)
    For Each rnCell In rgSortera
      rnCell.Value = _
    rnCell.Offset(0, 1).Interior.ColorIndex
Next
'Här sker sortering. Noterbart är dels sorterings-
'ordningen och att inga rubriker existerar (xlNo).
    Range(stStartCell).Sort Key1:=Range(stStartCell), _
    Order1:=xlAscending, Header:=xlNo, _
    Orientation:=xlTopToBottom
'Slutligen tas den temporära kolumnen bort.
    Range(stStartCell).EntireColumn.Delete
End If

SorteraEfterFärg_Exit:
     Application.ScreenUpdating = True
     Set rgSortera = Nothing
     Exit Sub

SorteraEfterFärg_Err:
     MsgBox Err.Number & ": " & Err.Description, _
     vbOKOnly, "Sortering efter färg"
     Resume SorteraEfterFärg_Exit
End Sub

Observera att de celler som ska sorteras måste innehålla data.