Help in sorting data

[Archies]

Hi

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 bu
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 correc
output. Can anyone please let me know where i am going wrong?

Below is my whole code:


Collapse | Copy Code
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 A
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 thin
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,
Archi

 

[Claus Busch]

Hi,

Am Sun, 21 Jul 2013 14:31:03 +0100 schrieb Archies:

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

try:

Sub Test()
Dim varOut As Variant
Dim myRng As Range

varOut = Split([A1], ";")
Set myRng = [B1].Resize(UBound(varOut) + 1, 1)
With myRng
.Value = WorksheetFunction.Transpose(varOut)
.Sort key1:=[B1], order1:=xlAscending, Header:=xlNo
End With
End Sub


Regards
Claus B.

 

[Claus Busch]

Hi,

Am Sun, 21 Jul 2013 16:10:28 +0200 schrieb Claus Busch:

and to write it back to a cell try:
Sub Test()
Dim varOut As Variant
Dim myRng As Range
Dim myStr As String

varOut = Split([A1], ";")
Set myRng = [B1].Resize(UBound(varOut) + 1, 1)
With myRng
.Value = WorksheetFunction.Transpose(varOut)
.Sort key1:=[B1], order1:=xlAscending, Header:=xlNo
End With
varOut = WorksheetFunction.Transpose(myRng)
myStr = Join(varOut, ";")
[C1] = myStr
End Sub


Regards
Claus B.