-
Hi
try this one. adjust the ranges accordingly.
Code:
Option Explicit
Sub Sort1()
Dim NonBlankData(), n As Long, r As Long, c As Long
Dim WholeData
WholeData = Range("R3:AC17").Value2
ReDim NonBlankData(1 To UBound(WholeData, 1), 1 To UBound(WholeData, 2))
For r = 1 To UBound(WholeData, 1)
'//check whether the first column has data. if so, proceed. Replace the 1 with appropriate column to check
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c)
Next
End If
Next
If n Then
With Range("AE3")
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2))
.sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If
End Sub
-
:):)
That worked like a Charm, Thanks a ton.
For other ranges in the same worksheet, I guess, I only need to change
Code:
WholeData = Range("R3:AC17").Value2
and rest of the code should be repeated for each range, no need to change the variable, also, I guess. I'll surely try for other ranges.
-
Code given in #11 works perfectly right, over the given range.
But, Now I want to repeate this process over other row range with same columns, so, I repeated the code as under (without variable, as that have already been declared)
Code:
WholeData = Range("R102:AC116").Value2
ReDim NonBlankData(1 To UBound(WholeData, 1), 1 To UBound(WholeData, 2))
For r = 1 To UBound(WholeData, 1)
'//check whether the first column has data. if so, proceed. Replace the 1 with appropriate column to check
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c) ' Error - Run time error 9, Subscript out of Range
Next
End If
Next
If n Then
With Range("AE102")
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2))
.sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If
I need to perform similar sorting over row
3 to 17
102 to 116
202 to 216
302 to 316 and so on till 1000+ rows
-
Hi
I guess the output you want in continuous range. If so, try this
Code:
Option Explicit
Sub SortData(ByRef Destination As Range, ParamArray SourceData())
Dim NonBlankData(), n As Long, r As Long, c As Long
Dim WholeData, i As Long
Const MaxOutputRows As Long = 1000
Const OutputColumns As Long = 12
ReDim NonBlankData(1 To MaxOutputRows, 1 To 12)
For i = LBound(SourceData) To UBound(SourceData)
WholeData = SourceData(i)
For r = 1 To UBound(WholeData, 1)
If Len(WholeData(r, 1)) Then
n = n + 1
For c = 1 To UBound(WholeData, 2)
NonBlankData(n, c) = WholeData(r, c)
Next
End If
Next
Next
If n Then
With Destination
.Resize(n, UBound(NonBlankData, 2)).Value2 = NonBlankData
With .Resize(n, UBound(NonBlankData, 2)) 'adjust the sorting columns. here it's 1,8 and 9th column of the output range
.Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Key2:=.Cells(1, 8), _
Order2:=xlDescending, Key3:=.Cells(1, 9), Order3:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
DataOption3:=xlSortNormal
End With
End With
End If
End Sub
'***** and call the procedure like this...
Sub kTest()
Dim rngDest As Range
Set rngDest = Worksheets("OSum").Range("AE102") '<< adjust the sheet name and the range
With Worksheets("OSum")
SortData rngDest, .Range("ae3:ap17").Value2, .Range("ae102:ap116").Value2, .Range("ae202:ap216").Value2 '<< add more ranges here
End With
End Sub
-
1 Attachment(s)
The revised sheet is attached, with more data in subsequent block every 100th row has 10 rows+column matrix which needs to be copied and sorted.
Somehow, unable to do.
Data position should not be changed, as in the adjacent area many rows columns have data from which some processing is being done, and final output is obtained, which is required to be re-arranged (sorted) from Column AE. Please have a look.
-
I've 15 such blocks having 10 rows each at interval of 100 rows. Should i create 15 variables, and re-write or how to do, it? Kindly explain.
-
Hi
As I told you add those 15 ranges in this procedure as an argument and run the macro.
Code:
Sub kTest()
Dim rngDest As Range
Set rngDest = Worksheets("OSum").Range("AE102") '<< adjust the sheet name and the range
With Worksheets("OSum")
'I have added 3 ranges here
SortData rngDest, .Range("r3:ac17").Value2, .Range("r102:ac116").Value2, .Range("r202:ac216").Value2 '<< add more ranges here separated by comma
End With
End Sub
Note: I have amended the SortData procedure in my earlier post.
-
My poor understanding, am not able to do the requisite. :(
-
I am trying, instead of putting all range in single line, am making different block, and it is working, thank u. Thank you Admin.
