Help in sorting data

Question

1.00/5 (1 vote)

See more:

Hi,

I have written the below code but its not working as i wanted.

I have below data in A1 cell (values separated by semi-colon)
A;C;B;M;U

ConvertToColumn() produces output as
A
C
B
M
U

sSortSelection() produces output in ascending order for above output but only when we select that particular range.

generateRow() produces the sorted output as
A;B;C;M;U

But when i run the final() function i am not able to get the correct output. Can anyone please let me know where i am going wrong?

Below is my whole code:

VB

Option Explicit

Sub ConvertToColumn()
    
   
    ' constants
    
    Const ksInputWS = "Sheet1"
   Const ksInputRange = "A1"
    Const ksOutputWS = "Sheet1"
   Const ksOutputRange = "B1"
    ' declarations
    Dim rngI As Range, rngO As Range
    Dim lRowI As Long, iColI As Integer, lRowO As Long, iColO As Integer
    Dim i As Long, J As Long, K As Integer, a As String, b As String
    Dim sArray() As String
    ' start
    Set rngI = Worksheets(ksInputWS).Range(ksInputRange)
    Set rngO = Worksheets(ksOutputWS).Range(ksOutputRange)
    With rngI
        lRowI = .Row
        iColI = .Column
    End With
    With rngO
        lRowO = .Row
        iColO = .Column
        .ClearContents
    End With
    
   
    ' process
    i = lRowI
    J = lRowO - 1
    With rngI
        Do Until .Cells(i, iColI).Value = ""
            ' row
            a = .Cells(i, iColI).Value
            ' split & fill
            sArray = Split(a, ";")
            For K = LBound(sArray()) To UBound(sArray())
                J = J + 1
                rngO.Cells(J, iColO).Value = sArray(K)
            Next K
            ' blank
            J = J + 1
            rngO.Cells(J, iColO).Value = ""
            ' cycle
            i = i + 1
        Loop
    End With
    ' end
 
  
    Beep
End Sub



Sub generateRow()

Dim i As Integer
Dim s As String

i = 1

Do Until Cells(i, 1).Value = ""
    If (s = "") Then
        s = Cells(i, 1).Value
    Else
        s = s & ";" & Cells(i, 1).Value
    End If
    i = i + 1
Loop

Cells(1, 5).Value = s

End Sub

Public Sub sSortSelection()

'use the keyword "Selection" for the currently selected range (i think the issue is here itself but not sure what to use here instead)
With ActiveSheet.sort
    .SortFields.Clear

    .SortFields.Add Key:=Selection.Columns(1), Order:=xlAscending
    .SetRange Selection
    .Apply
End With

End Sub

Sub final()
SplitAndTranspo
sSortSelection
generateRow
End Sub

Thanks in advance

Regards,
Archie

[edit]Code block added - OriginalGriff[/edit]

Posted 20-Jul-13 19:07pm

archies_gall

Updated 20-Jul-13 21:04pm

OriginalGriff

v2

Add a Solution

2 solutions

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Maciej Los · Answer 1 · 2013-07-21T23:55:00

Try this:

VB

Option Explicit

'Copy & Paste with Trasnpose option
Sub Cols2Rows1()
Dim sInputCell As String, sOutputString As String
Dim rng As Range, i As Integer

sInputCell = "A1"
Set rng = ThisWorkbook.Worksheets(1).Range(sInputCell)
rng = "A;C;B;M;U;E;N;D"

rng.TextToColumns Destination:=rng, DataType:=xlDelimited, _
        TextQualifier:=xlNone, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:=";"
        
ThisWorkbook.Worksheets(1).Range(rng, rng.End(xlToRight)).Copy
Set rng = ThisWorkbook.Worksheets(2).Range(sInputCell)
rng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
rng.Sort Key1:=rng, Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        
i = 1
Do While ThisWorkbook.Worksheets(2).Range("A" & i) <> ""
    sOutputString = sOutputString & ThisWorkbook.Worksheets(2).Range("A" & i) & ";"
    i = i + 1
Loop

sOutputString = Left(sOutputString, Len(sOutputString) - 1)
ThisWorkbook.Worksheets(1).Cells.Clear
ThisWorkbook.Worksheets(2).Cells.Clear
ThisWorkbook.Worksheets(1).Range(sInputCell) = sOutputString

MsgBox "Sorted!"

End Sub

archies_gall · Answer 2 · 2013-07-22T18:05:00

Hi Maciej,

Thanks for the code. But the value in "rng" should not be hardcoded. it should take all the values present in column A, sort them and then add delimiter to it.
I tried merging this code with mine with few changes but then only first cell value is remaining and other values are disappearing :(

Regards,

Help in sorting data

2 solutions

Solution 1

Solution 2

Add your solution here

Preview 0