Ik wil een tabel sorteren op kleur. Aangezien ik geen VBA ken heb ik in dit forum gezocht en gevonden een macro die dat uit zou kunnen voeren. Maar hij werkt niet. Wat er in de macro gebeurt is dat er in een lege kolom cijfers geplaatst worden, over de complete lengte van de kolom (ik heb even de regel waarin entire column delete staat, uitgezet om te zien wat er gebeurde) en dan komen helemaal onderaan de getallen van mijn kleuren te staan, echter de kleuren zelf worden niet meegenomen. Wie kan mij verder helpen. Alvast dank voor jullie reactie. Poekelaar.
Onderstaand de macro zoals ik die hier op het forum gevonden had.
Sub SortByColor()
'Sorteert een range op opmaakkleur
'The macro works by first asking you the beginning cell of the range you want to sort.
'This should be the top-most cell in the range.
'The macro then inserts a column (just temporarily) in which color values can be stored.
'It then steps through each cell in the range defined by the starting cell you specified.
'SortByColor assumes your data table doesn't have a header row.
'If it does, you should change the actual sorting command.
'Simply change Header:=xlNo to Header:=xlYes.
On Error GoTo SortByColor_Err
Dim sRangeAddress As String
Dim sStartCell As String
Dim sEndCell As String
Dim rngSort As Range
Dim rng As Range
'Application.ScreenUpdating = False
sStartCell = InputBox("Geef het adres van de eerste cel " & _
"in het op kleur te sorteren gebied." & _
Chr(13) & "bijv. 'A1'", "Geef het celadres")
If sStartCell <> "" Then
sEndCell = Range(sStartCell).End(xlDown).Address
Range(sStartCell).EntireColumn.Insert
Set rngSort = Range(sStartCell, sEndCell)
For Each rng In rngSort
rng.Value = rng.Offset(0, 1).Interior.ColorIndex
Next
Range(sStartCell).Sort Key1:=Range(sStartCell), _
Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlTopToBottom
Range(sStartCell).EntireColumn.Delete
End If
SortByColor_Exit:
Application.ScreenUpdating = True
Set rngSort = Nothing
Exit Sub
SortByColor_Err:
MsgBox Err.Number & ": " & Err.Description, _
vbOKOnly, "SortByColor"
Resume SortByColor_Exit
End Sub
Onderstaand de macro zoals ik die hier op het forum gevonden had.
Sub SortByColor()
'Sorteert een range op opmaakkleur
'The macro works by first asking you the beginning cell of the range you want to sort.
'This should be the top-most cell in the range.
'The macro then inserts a column (just temporarily) in which color values can be stored.
'It then steps through each cell in the range defined by the starting cell you specified.
'SortByColor assumes your data table doesn't have a header row.
'If it does, you should change the actual sorting command.
'Simply change Header:=xlNo to Header:=xlYes.
On Error GoTo SortByColor_Err
Dim sRangeAddress As String
Dim sStartCell As String
Dim sEndCell As String
Dim rngSort As Range
Dim rng As Range
'Application.ScreenUpdating = False
sStartCell = InputBox("Geef het adres van de eerste cel " & _
"in het op kleur te sorteren gebied." & _
Chr(13) & "bijv. 'A1'", "Geef het celadres")
If sStartCell <> "" Then
sEndCell = Range(sStartCell).End(xlDown).Address
Range(sStartCell).EntireColumn.Insert
Set rngSort = Range(sStartCell, sEndCell)
For Each rng In rngSort
rng.Value = rng.Offset(0, 1).Interior.ColorIndex
Next
Range(sStartCell).Sort Key1:=Range(sStartCell), _
Order1:=xlAscending, Header:=xlNo, _
Orientation:=xlTopToBottom
Range(sStartCell).EntireColumn.Delete
End If
SortByColor_Exit:
Application.ScreenUpdating = True
Set rngSort = Nothing
Exit Sub
SortByColor_Err:
MsgBox Err.Number & ": " & Err.Description, _
vbOKOnly, "SortByColor"
Resume SortByColor_Exit
End Sub
