Sortcode

[Symphysodon]

Beste forummers,
Om gek van te worden. Ik probeer een sorteer code te maken horizontaal en verticaal

Sub sorteer()
    Dim inputWs As Worksheet
    Set inputWs = ActiveWorkbook.Sheets("Exported Analyses")
    Dim lR As Long
    Dim lK As Long
    Dim sorteerRng As Range

    lR = inputWs.Cells(Rows.Count, 1).End(xlUp).Row
    lK = inputWs.Cells(1, Columns.Count).End(xlToLeft).Column

    inputWs.Columns(9).NumberFormat = "@"
    Set horRng = inputWs.Range(inputWs.Cells(1, 10), inputWs.Cells(lR, lK)) 'horizon
    Set sorteerRng = horRng
    With inputWs.Sort
        .SortFields.Clear
        .SortFields.Add2 sorteerRng.Rows(1), xlSortOnValues, xlAscending, xlSortNormal
        .SetRange sorteerRng
        .Header = xlYes
        .MatchCase = False
        .Orientation = 2
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
    'Deze code werkt wel!!!
'    Range("I1").Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Range(Selection, Selection.End(xlDown)).Select
'    ActiveWorkbook.Worksheets("Exported Analyses").Sort.SortFields.Clear
'    ActiveWorkbook.Worksheets("Exported Analyses").Sort.SortFields.Add2 Key:= _
'        Range("I1:I15"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
'        xlSortTextAsNumbers
'    With ActiveWorkbook.Worksheets("Exported Analyses").Sort
'        .SetRange Range("I1:AJ15")
'        .Header = xlYes
'        .MatchCase = False
'        .Orientation = xlTopToBottom
'        .SortMethod = xlPinYin
'        .Apply
'    End With

    
'Deze code werkt niet.
    Set vertRng = inputWs.Range(inputWs.Cells(1, 9), inputWs.Cells(lR, lK)) 'vert
    Set sorteerRng = vertRng
    sorteerRng.Select

    With inputWs.Sort
        .SortFields.Clear
        .SortFields.Add2 inputWs.Range(inputWs.Cells(1, 9), inputWs.Cells(lR, 9)), xlSortOnValues, xlAscending, xlSortTextAsNumbers
        .SetRange sorteerRng
        .Header = xlYes
        .MatchCase = False
        .Orientation = 1
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Het laatste gedeelte werkt dus niet. Het deel tussen quotes (macrorecorder) werkt wel. Zoek de verschillen.

Alvast bedankt.

mvg
Marco

 

[Symphysodon]

Gelukt, ik had het bereik toch nog niet goed vastgelegd. Ik heb het bereik in het tweede gedeelte aangepast vanaf de eerste rij onder de header rij en door de header op xlNo te zetten gaat het nu wel goed.

Sub sorteer()
    Dim inputWs As Worksheet
    Set inputWs = ActiveWorkbook.Sheets("Exported Analyses")
    Dim lR As Long
    Dim lK As Long
    Dim sorteerRng As Range

    lR = inputWs.Cells(Rows.Count, 1).End(xlUp).Row
    lK = inputWs.Cells(1, Columns.Count).End(xlToLeft).Column

    inputWs.Columns(9).NumberFormat = "@"
    Set horRng = inputWs.Range(inputWs.Cells(1, 10), inputWs.Cells(lR, lK)) 'horizon
    Set sorteerRng = horRng
    With inputWs.Sort
        .SortFields.Clear
        .SortFields.Add2 sorteerRng.Rows(1), xlSortOnValues, xlAscending, xlSortNormal
        .SetRange sorteerRng
        .Header = xlYes
        .MatchCase = False
        .Orientation = 2
        .SortMethod = xlPinYin
        .Apply
    End With

    Set vertRng = inputWs.Range(inputWs.Cells(2, 9), inputWs.Cells(lR, lK)) 'vert
    Set sorteerRng = vertRng
    
    With inputWs.Sort
        .SortFields.Clear
        .SortFields.Add2 inputWs.Range(inputWs.Cells(2, 9), inputWs.Cells(lR, 9)), xlSortOnValues, xlAscending, xlSortTextAsNumbers
        .SetRange sorteerRng
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

 

[Symphysodon]

Iedereen bedankt voor het meedenken.

 

[AD1957]

Wat moeten de helpers hier van denken ?

 

[Symphysodon]

Dat ik ze erg dankbaar ben voor de hulp, ook al is deze voor mij in dit geval niet zichtbaar. Tenslotte hebben wel 177 mensen het bericht gelezen en mogelijke oplossingen bedacht maar niemand heeft iets gepost.

Mvg,
Marco