Thanks Pankaj & Mandeep, all the codes running properly on real time data.
On Fri, Jan 15, 2016 at 7:10 PM, Pankaj Sharma <pankaj123...@gmail.com>
wrote:
> Result type2 is here:
>
>
> Sub SortRangeData2()
>
> Dim sh1 As Worksheet, sh2 As Worksheet
> Dim rng1 As Range, rng2 As Range, rng As Range, data As Range
> Dim arr As Variant, arr2 As String, txt As String
> Dim i As Long, lr As Long
> Set sh1 = ActiveSheet
>
> On Error Resume Next
> Set data = Application.Selection
> Set data = Application.InputBox("Selet Data", Type:=8)
>
> Application.DisplayAlerts = False
> Application.ScreenUpdating = False
>
> Worksheets.Add after:=Sheets(Sheets.Count)
> Set sh2 = ActiveSheet
>
> For Each rng1 In data
> arr = VBA.Split(rng1, ",")
> For i = 0 To UBound(arr)
> sh2.Cells((i + 1), 1).Value = arr(i)
> sh2.Cells((i + 1), 2).FormulaR1C1 = "=LEN(RC[-1])"
> Next i
>
> lr = sh2.Range("A" & Rows.Count).End(xlUp).Row
> sh2.Range("A1:B" & lr).Select
> With Selection
> sh2.Sort.SortFields.Clear
> sh2.Sort.SortFields.Add Key:=Range("B1"),
> Order:=xlAscending
> sh2.Sort.SortFields.Add Key:=Range("A1"),
> Order:=xlAscending
> End With
>
> With sh2.Sort
> .SetRange Selection
> .Header = xlNo
> .MatchCase = False
> .Orientation = xlTopToBottom
> .SortMethod = xlPinYin
> .Apply
> End With
> sh2.Range("D1").Select
>
> sh2.Range("A1:A" & lr).Select
> For Each rng In Selection
> txt = rng & ","
> arr2 = arr2 & txt
> Next rng
>
> sh2.Range("A1:B" & lr).Clear
> rng1.Offset(0, 2).Value = arr2
> arr2 = ""
> Next rng1
>
> sh2.Delete
> If ActiveSheet.Name <> sh1.Name Then sh1.Activate
>
> Application.DisplayAlerts = True
> Application.ScreenUpdating = True
>
> End Sub
>
>
>
>
>
>
> *PJ *
>
> *MIS Analyst*
>
>
> *Greater Kailash-1, New Delhi.*
>
> *Instagram* *pj_sharma_*
>
> *Tweeter*
> *dude_sharma_pj**Facebook** www.facebook.com/dude.pj
> <http://www.facebook.com/dude.pj>*
>
>
> *We meet for a reason, either you're a blessing or a lesson...*
>
> On Fri, Jan 15, 2016 at 6:02 PM, Mandeep Baluja <rockerna...@gmail.com>
> wrote:
>
>> Hey Devendra,
>>
>> This code made me insane :*0,Let me tell you why ??
>> 1) Numerous of Keywords Integers,Y,Years,SR Doesn't understood the
>> meaning what they are denoting Except years.
>> 2) Took(Almost 2.5 hour).
>>
>> Sorting is easy when all are numbers but difficult when Text values !!
>> the previous code you were using was doing nothing like sorting they are
>> just comparing on the basis of Text values That code was comparing Text
>> values like 10-12 years,11-15 years in which 10,10years,15 years in which 1
>> comes first and they are providing you the same.
>>
>> I Tried my best to solve your problem but this code will gives you
>> different result if your Data keywords will change.
>>
>> I followed this way for Sorting if I go as per sorting rule of numbers !!
>> Sorting -Way ->>> Interger--->then----> Y values----> years values
>> --->Rest of values(which are not integer not years,not Y God knows What
>> they are)
>>
>> Here's the code !!! Note this code very specific for keywords you have
>> provided to me Y,Years,Integers,SR,Normal
>>
>>
>> Sub SOA()
>>
>> On Error Resume Next
>>
>> Application.ScreenUpdating = False
>>
>> Dim ws As Worksheet
>> Dim counter As Long: counter = 1
>> Dim Nrows As Long
>>
>> Set ws = ActiveWorkbook.Sheets("Sheet3")
>> Set ws1 = ActiveWorkbook.Sheets("Data")
>>
>> Nrows = ws1.Cells(Rows.Count, 2).End(xlUp).Row 'Get no of rows
>>
>> For Rownum = 2 To Nrows
>> ws.Cells.ClearContents 'Clear the rough sheet
>> Set temp = Nothing 'A variable to hold the result
>>
>> Dim varout1() As Variant
>> Dim varout() As Variant
>>
>> var1 = Split(ws1.Cells(Rownum, "B"), ",")
>> For i = LBound(var1) To UBound(var1)
>> If IsNumeric(var1(i)) Then
>> ReDim Preserve varout1(1 To counter)
>> varout1(counter) = var1(i)
>> counter = counter + 1
>> End If
>> Next
>> Sheets("sheet3").Range("a1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>>
>> '--------------------------------------------------------------------
>> counter = 1
>> Debug.Print ws1.Cells(Rownum, "B")
>> var1 = Split(ws1.Cells(Rownum, "B"), ",")
>> For i = LBound(var1) To UBound(var1)
>> If Right(var1(i), 1) = "Y" Then
>> ReDim Preserve varout1(1 To counter)
>> varout1(counter) = var1(i)
>> counter = counter + 1
>> End If
>> Next
>> Sheets("sheet3").Range("c1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>> Sheets("sheet3").Range("D1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>> '-------------------------------------------------------------
>> counter = 1
>> var1 = Split(ws1.Cells(Rownum, "B"), ",")
>> For i = LBound(var1) To UBound(var1)
>> If var1(i) Like "*Years*" Then
>> ReDim Preserve varout1(1 To counter)
>> varout1(counter) = var1(i)
>> counter = counter + 1
>> End If
>> Next
>> Sheets("sheet3").Range("f1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>> Sheets("sheet3").Range("G1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>>
>>
>> '-----------------------------------------------------------------------------------------------------
>> counter = 1
>> var1 = Split(ws1.Cells(Rownum, "B"), ",")
>> For i = LBound(var1) To UBound(var1)
>> If Not var1(i) Like "*Years*" Then
>> If Not Right(var1(i), 1) = "Y" Then
>> If Not IsNumeric(var1(i)) = True Then
>> ReDim Preserve varout1(1 To counter)
>> varout1(counter) = var1(i)
>> counter = counter + 1
>> End If
>> End If
>> End If
>> Next
>> Sheets("sheet3").Range("K1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>> Sheets("sheet3").Range("L1").Resize(UBound(varout1), 1) =
>> Application.Transpose(varout1)
>>
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Clear
>> lr = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Add
>> Key:=Sheets("Sheet3").Range("A1"), _
>> SortOn:=xlSortOnValues, Order:=xlAscending,
>> DataOption:=xlSortNormal
>> With ActiveWorkbook.Worksheets("Sheet3").sort
>> .SetRange ws.Range("A1:B" & lr)
>> .Header = xlGuess
>> .MatchCase = False
>> .Orientation = xlTopToBottom
>> .SortMethod = xlPinYin
>> .Apply
>> End With
>>
>> lr = Sheets("Sheet3").Cells(Rows.Count, 3).End(xlUp).Row
>>
>> Sheets("Sheet3").Columns("C:C").Replace What:="-*", Replacement:="",
>> LookAt:=xlPart, _
>> SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
>> ReplaceFormat:=False
>> Sheets("Sheet3").Columns("C:C").Replace What:="Y", Replacement:="",
>> LookAt:=xlPart, _
>> SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
>> ReplaceFormat:=False
>> '--------------------------Sorting column second
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Clear
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Add
>> Key:=Sheets("Sheet3").Range("C1"), _
>> SortOn:=xlSortOnValues, Order:=xlAscending,
>> DataOption:=xlSortNormal
>> With ActiveWorkbook.Worksheets("Sheet3").sort
>> .SetRange Range("C1:D" & lr)
>> .Header = xlGuess
>> .MatchCase = False
>> .Orientation = xlTopToBottom
>> .SortMethod = xlPinYin
>> .Apply
>> End With
>>
>>
>> '-------------------------------------------------------------------------------
>> lr = Sheets("Sheet3").Cells(Rows.Count, 6).End(xlUp).Row
>>
>> Sheets("Sheet3").Columns("F:F").Replace What:="-*", Replacement:="",
>> LookAt:=xlPart, _
>> SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
>> ReplaceFormat:=False
>>
>> Sheets("Sheet3").Columns("F:F").Replace What:="Years", Replacement:="",
>> LookAt:=xlPart, _
>> SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
>> ReplaceFormat:=False
>>
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Clear
>> ActiveWorkbook.Worksheets("Sheet3").sort.SortFields.Add
>> Key:=Sheets("Sheet3").Range("f1"), _
>> SortOn:=xlSortOnValues, Order:=xlAscending,
>> DataOption:=xlSortNormal
>> With ActiveWorkbook.Worksheets("Sheet3").sort
>> .SetRange Range("f1:g" & lr)
>> .Header = xlGuess
>> .MatchCase = False
>> .Orientation = xlTopToBottom
>> .SortMethod = xlPinYin
>> .Apply
>> End With
>>
>> 'Dim varout() As Variant
>> counter = 1
>> l1 = Sheets("Sheet3").Cells(Rows.Count, 1).End(xlUp).Row
>> l2 = Sheets("Sheet3").Cells(Rows.Count, 4).End(xlUp).Row
>> l3 = Sheets("Sheet3").Cells(Rows.Count, 7).End(xlUp).Row
>> l4 = Sheets("Sheet3").Cells(Rows.Count, 11).End(xlUp).Row
>>
>> For i = 1 To l1
>> ReDim Preserve varout(1 To counter)
>> varout(i) = ws.Cells(i, 1).Value
>> counter = counter + 1
>> Next
>> ' MsgBox Join(varout, ",")
>>
>> For j = 1 To l2
>> ReDim Preserve varout(1 To counter + 1)
>> varout(counter) = ws.Cells(j, 4).Value
>> counter = counter + 1
>> Next
>>
>> 'MsgBox Join(varout, ",")
>> For k = 1 To l3
>> ReDim Preserve varout(1 To counter + 1)
>> varout(counter) = ws.Cells(k, 7).Value
>> counter = counter + 1
>> Next
>>
>>
>> For L = 1 To l4
>> ReDim Preserve varout(1 To counter + 1)
>> varout(counter) = ws.Cells(L, 11).Value
>> counter = counter + 1
>> Next
>>
>> temp = Join(varout, ",")
>> ws1.Cells(Rownum, "C").Value = temp
>> Next
>> 'ws.Cells.ClearContents
>>
>> End Sub
>>
>>
>> Regards,
>> Mandeep baluja
>> https://www.facebook.com/groups/825221420889809/
>>
>>
>>
>>
>> --
>> Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
>> =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
>> https://www.facebook.com/discussexcel
>>
>> FORUM RULES
>>
>> 1) Use concise, accurate thread titles. Poor thread titles, like Please
>> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice
>> will not get quick attention or may not be answered.
>> 2) Don't post a question in the thread of another member.
>> 3) Don't post questions regarding breaking or bypassing any security
>> measure.
>> 4) Acknowledge the responses you receive, good or bad.
>> 5) Jobs posting is not allowed.
>> 6) Sharing copyrighted material and their links is not allowed.
>>
>> NOTE : Don't ever post confidential data in a workbook. Forum owners and
>> members are not responsible for any loss.
>> ---
>> You received this message because you are subscribed to the Google Groups
>> "MS EXCEL AND VBA MACROS" group.
>> To unsubscribe from this group and stop receiving emails from it, send an
>> email to excel-macros+unsubscr...@googlegroups.com.
>> To post to this group, send email to excel-macros@googlegroups.com.
>> Visit this group at https://groups.google.com/group/excel-macros.
>> For more options, visit https://groups.google.com/d/optout.
>>
>
> --
> Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
> =TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
> https://www.facebook.com/discussexcel
>
> FORUM RULES
>
> 1) Use concise, accurate thread titles. Poor thread titles, like Please
> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice
> will not get quick attention or may not be answered.
> 2) Don't post a question in the thread of another member.
> 3) Don't post questions regarding breaking or bypassing any security
> measure.
> 4) Acknowledge the responses you receive, good or bad.
> 5) Jobs posting is not allowed.
> 6) Sharing copyrighted material and their links is not allowed.
>
> NOTE : Don't ever post confidential data in a workbook. Forum owners and
> members are not responsible for any loss.
> ---
> You received this message because you are subscribed to the Google Groups
> "MS EXCEL AND VBA MACROS" group.
> To unsubscribe from this group and stop receiving emails from it, send an
> email to excel-macros+unsubscr...@googlegroups.com.
> To post to this group, send email to excel-macros@googlegroups.com.
> Visit this group at https://groups.google.com/group/excel-macros.
> For more options, visit https://groups.google.com/d/optout.
>
--
With Regard !!!
Devendra Rahi
--
Are you =EXP(E:RT) or =NOT(EXP(E:RT)) in Excel? And do you wanna be? It’s
=TIME(2,DO:IT,N:OW) ! Join official Facebook page of this forum @
https://www.facebook.com/discussexcel
FORUM RULES
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Jobs posting is not allowed.
6) Sharing copyrighted material and their links is not allowed.
NOTE : Don't ever post confidential data in a workbook. Forum owners and
members are not responsible for any loss.
---
You received this message because you are subscribed to the Google Groups "MS
EXCEL AND VBA MACROS" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to excel-macros+unsubscr...@googlegroups.com.
To post to this group, send email to excel-macros@googlegroups.com.
Visit this group at https://groups.google.com/group/excel-macros.
For more options, visit https://groups.google.com/d/optout.
