PDA

View Full Version : SORT COLUMNS VBA



teodormircea
03-20-2009, 08:59 AM
Hello Forum,

I'm trying to modify this code in order to chose the columns i want to sort in a range
Apparently i'm not using the right method,could some one help me with this little project.

Thanks

Bob Phillips
03-20-2009, 10:17 AM
That code seems awfully complex for a little sort. What is your selection logice here?

teodormircea
03-20-2009, 01:35 PM
well.i want the macros to detect the range automatically, last column last range -1 (-subtotal)
to give a a choice ascending or descending, and chose the columns, exactly like data sort from excel

lucas
03-21-2009, 07:15 AM
I may be missing something but why would you want to duplicate something that excel has a native interface for?

Is this just practice?

teodormircea
03-21-2009, 02:58 PM
Yes just want to producee what excel does , by macros

teodormircea
03-30-2009, 07:09 AM
Hello again
i found a solution but i need a little help
Here the code for combobox, here i chose the columns


Private Sub CBO_Fill()
Dim oRng As Range
'Remplit la Combo
With ActiveSheet
Set oRng = Range(.Cells(1, 1), .Cells(1, Columns.Count).End(xlToLeft))
ComboBox1.List = Application.Transpose(oRng)
ComboBox2.List = Application.Transpose(oRng)
ComboBox3.List = Application.Transpose(oRng)
End With
ComboBox1.ListIndex = 0
ComboBox2.ListIndex = 0
ComboBox3.ListIndex = 0
End Sub


Then a function to find the used range -last one


Public Function RealUsedRange() As Range

Dim FirstRow As Long
Dim LastRow As Long
Dim FirstColumn As Integer
Dim LastColumn As Integer

On Error Resume Next

FirstRow = Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext).Row

FirstColumn = Cells.Find(What:="*", After:=Range("IV65536"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext).Column

LastRow = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row - 1

LastColumn = Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set RealUsedRange = Range(Cells(FirstRow, FirstColumn), Cells(LastRow, LastColumn))

On Error GoTo 0

End Function
Here to initialize the combo and select the range

Sub Range_SORT()

Dim Rng1 As Range

Set Rng1 = RealUsedRange
If Rng1 Is Nothing Then
MsgBox "There is no used range, the worksheet is empty."
Else
CBO_Fill
Rng1.Select

End If
End Sub
No i need the code to sort, the selected range with the selected columns, ascending.

teodormircea
03-31-2009, 07:50 AM
Here by USF with an excel example,
need only to do the code for sorting, any ideas ????

mogulempire
07-06-2009, 09:59 AM
Try the following:
Change ColArray(0) = X to ColArray(0)="A" and likewise for ColArray(1) and ColArray(2)
Greg

anandbohra
07-07-2009, 03:55 AM
Hi
Earlier I found this code in one of the workbook while googling (NOT MY CODE). But kept it in my collection.

try this

put your data in database format (proper heading no merge cells etc etc)
then run this code "SetupOneTime"

Option Explicit
Sub SetupOneTime()

Dim myRng As Range
Dim myCell As Range
Dim curWks As Worksheet
Dim myRect As Shape
Dim iCol As Integer
iCol = ActiveSheet.UsedRange.Columns.Count 'All Columns


Set curWks = ActiveSheet

On Error Resume Next
curWks.DrawingObjects.Select
Selection.Cut


With curWks

Set myRng = .Range("a1").Resize(1, iCol)
For Each myCell In myRng.Cells
With myCell
Set myRect = .Parent.Shapes.AddShape _
(Type:=msoShapeRectangle, _
Top:=.Top, Height:=.Height, _
Width:=.Width, Left:=.Left)
End With
With myRect
.OnAction = "SortTable"
.Fill.Visible = False
.Line.Visible = False
End With
Next myCell
End With
End Sub

Sub SortTable()


Dim myTable As Range
Dim myColToSort As Long
Dim curWks As Worksheet
Dim mySortOrder As Long
Dim FirstRow As Long
Dim TopRow As Long
Dim LastRow As Long
Dim iCol As Integer
Dim strCol As String
Dim rng As Range
Dim rngF As Range

TopRow = 1
iCol = ActiveSheet.UsedRange.Columns.Count 'All Columns
strCol = "A" ' column to check for last row

Set curWks = ActiveSheet

With curWks
LastRow = .Cells(.Rows.Count, strCol).End(xlUp).Row
If Not .AutoFilterMode Then
Set rng = .Range(.Cells(TopRow, strCol), .Cells(LastRow, strCol))
Else
Set rng = .AutoFilter.Range
End If

Set rngF = Nothing
On Error Resume Next
With rng
'visible cells first column of range
Set rngF = .Offset(1, 0).Resize(.Rows.Count - 1, 1) _
.SpecialCells(xlCellTypeVisible)
End With
On Error GoTo 0

If rngF Is Nothing Then
MsgBox "No visible rows. Please try again."
Exit Sub
Else
FirstRow = rngF(1).Row
End If

myColToSort = .Shapes(Application.Caller).TopLeftCell.Column

Set myTable = .Range("A" & TopRow & ":A" & LastRow).Resize(, iCol)
If .Cells(FirstRow, myColToSort).Value _
< .Cells(LastRow, myColToSort).Value Then
mySortOrder = xlDescending
Else
mySortOrder = xlAscending
End If
myTable.Sort key1:=.Cells(FirstRow, myColToSort), _
order1:=mySortOrder, _
header:=xlYes
End With

End Sub

rbrhodes
07-07-2009, 04:25 AM
Yes just want to producee what excel does , by macros



Well it ain't easy. :p