teodormircea
Active Member
- Joined
- Jan 8, 2008
- Messages
- 331
Hello Forum
I found this code on the forum, is great , i want to modify it in order to be able to chose the columns i want to sort.
Here the code.
The modification doesn't work.
I found this code on the forum, is great , i want to modify it in order to be able to chose the columns i want to sort.
Here the code.
Code:
Dim DirArray() As Boolean
Dim ColArray() As String
Dim FCol As Integer
Dim LCol As Integer
Dim FirstCol As String
Dim LastCol As String
Dim FirstRow As Integer
Dim LastRow As Integer
Dim Odn As Integer
Dim EntryNum As Integer
Dim FRFix As Integer
Dim LRFix As Integer
Dim RowScan As Integer
Dim EndOfArray As Integer
Dim X, Y, Z As Integer
Selection.CurrentRegion.Select
FCol = Selection.Column
LCol = Selection.Columns(Selection.Columns.Count).Column
FirstCol = Chr(Asc("A") - 1 + FCol)
LastCol = Chr(Asc("A") - 1 + LCol)
FirstRow = Selection.Row
LastRow = Selection.Rows(Selection.Rows.Count).Row
ReDim Preserve DirArray(2) As Boolean
ReDim Preserve ColArray(2) As String
If MsgBox("Cocher HEADER,POUR UN SORT ASCENDANT COCHER OPTION SORT, SI NON SORT DESCENDANT PAR DEFAUT ", vbYesNo, "Continuer pour MARQUER") = vbYes Then
'Column to sort
X = TextBox122
Y = TextBox123
Z = TextBox124
DirArray(0) = OB1.Value
ColArray(0) = X
DirArray(1) = OB1.Value
ColArray(1) = Y
DirArray(2) = OB1.Value
ColArray(2) = Z
EndOfArray = 2
FirstRow = FirstRow - CBx1.Value
Odn = 2 + DirArray(0)
Range(FirstCol & FirstRow & ":" & LastCol & LastRow).Sort Key1:=Range(ColArray(0) & FirstRow), Order1:=Odn, Header:=xlNo
For EntryNum = 1 To EndOfArray
FRFix = 0
LRFix = 0
For RowScan = FirstRow To LastRow
If FRFix = 0 And Range(ColArray(EntryNum - 1) & RowScan).Value = Range(ColArray(EntryNum - 1) & (RowScan + 1)).Value Then
FRFix = RowScan
End If
If FRFix <> 0 And Range(ColArray(EntryNum - 1) & RowScan).Value <> Range(ColArray(EntryNum - 1) & (RowScan + 1)).Value Then
LRFix = RowScan
End If
If FRFix <> 0 And LRFix <> 0 Then
Odn = 2 + DirArray(EntryNum)
Range(FirstCol & FRFix & ":" & LastCol & LRFix).Sort Key1:=Range(ColArray(EntryNum) & FRFix), Order1:=Odn, Header:=xlNo
FRFix = 0
LRFix = 0
End If
Next RowScan
Next EntryNum
End If
End Sub