redchilli
11-18-2012, 07:15 AM
I have been using this code to sort with multiple rows and columns is any other short code possible.
Please help.
Sub Sort0()
Dim i As Long
Dim c As Long
Dim u As Long
Dim Frow As String
Dim Lrow As String
Dim sColumn As Variant
Dim fColumn As Variant
Dim StrMyValue As Variant
Dim NewStr As Variant
Dim str2 As String
StrMyValue = Selection.Address
c = 0
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
fColumn = Split(Range(StrMyValue).Offset(0, c).Address, ":")
If UBound(fColumn) > 0 Then
For u = 1 To Len(fColumn(0))
If Mid(fColumn(0), u, 1) <> "$" And IsNumeric(Mid(fColumn(0), u, 1)) Then
Frow = Frow & Mid(fColumn(0), u, 1)
End If
Next
For u = 1 To Len(fColumn(1))
If Mid(fColumn(1), u, 1) <> "$" And IsNumeric(Mid(fColumn(1), u, 1)) Then
Lrow = Lrow & Mid(fColumn(1), u, 1)
End If
Next
If Frow <> Lrow Then
For i = 1 To Range(StrMyValue).Columns.Count
sColumn = Range(fColumn(1)).Offset(0, c).Address
c = c - 1
For u = 1 To Len(sColumn)
If Mid(sColumn, u, 1) <> "$" And Not IsNumeric(Mid(sColumn, u, 1)) Then
str2 = str2 + Mid(sColumn, u, 1)
End If
Next
NewStr = str2 & Frow & ":" & str2 & Lrow
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(NewStr) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
str2 = ""
Str1 = ""
Next
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range(StrMyValue)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
End Sub
Please help.
Sub Sort0()
Dim i As Long
Dim c As Long
Dim u As Long
Dim Frow As String
Dim Lrow As String
Dim sColumn As Variant
Dim fColumn As Variant
Dim StrMyValue As Variant
Dim NewStr As Variant
Dim str2 As String
StrMyValue = Selection.Address
c = 0
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
fColumn = Split(Range(StrMyValue).Offset(0, c).Address, ":")
If UBound(fColumn) > 0 Then
For u = 1 To Len(fColumn(0))
If Mid(fColumn(0), u, 1) <> "$" And IsNumeric(Mid(fColumn(0), u, 1)) Then
Frow = Frow & Mid(fColumn(0), u, 1)
End If
Next
For u = 1 To Len(fColumn(1))
If Mid(fColumn(1), u, 1) <> "$" And IsNumeric(Mid(fColumn(1), u, 1)) Then
Lrow = Lrow & Mid(fColumn(1), u, 1)
End If
Next
If Frow <> Lrow Then
For i = 1 To Range(StrMyValue).Columns.Count
sColumn = Range(fColumn(1)).Offset(0, c).Address
c = c - 1
For u = 1 To Len(sColumn)
If Mid(sColumn, u, 1) <> "$" And Not IsNumeric(Mid(sColumn, u, 1)) Then
str2 = str2 + Mid(sColumn, u, 1)
End If
Next
NewStr = str2 & Frow & ":" & str2 & Lrow
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range(NewStr) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
str2 = ""
Str1 = ""
Next
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range(StrMyValue)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
End If
End Sub