[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 987
  • Last Modified:

Sorting values in a cell horizontally

I am using Excel 2010.

I have some values in several cells, like such:

1 3 12 5
2 14 1 4
etc...

I want to sort them horizontally only, meaning the result should be:
1 2 5 12
1 2 4 14
etc...

Without changing the vertical order.

Any way to achieve this?

Thanks!


0
keks_
Asked:
keks_
  • 9
  • 5
  • 5
  • +4
1 Solution
 
JoeNuvoCommented:
when you perform sorting
look for "Options",  you can change it to sort left to right.
0
 
wchhCommented:
Sort ->Option->Orientation->Sort Left to Right
Select Range Row by Row
0
 
JoeNuvoCommented:
oops, my error

seem should define macro/vba
since sort left to right will sort other rows follow the first row.
0
Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

 
MakriniCommented:
Keks means sorting left to right *within* a Cell.  I am working on another problem at the moment.  

Will come back to this if its not sorted out by someone else before I finish
0
 
ssisworoCommented:
goto sort options, change the orientation :
"Sort left to right"
from the default "Sort to to bottom"
0
 
wchhCommented:
Try Macro Below
Sub Macro1()
    Dim i As Long
    ActiveSheet.Sort.SortFields.Clear
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range("A" & i & ":D" & i), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("A" & i & ":D" & i)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
        Next
End Sub

Open in new window

Sub Macro1()
    Dim i As Long
    ActiveSheet.Sort.SortFields.Clear
    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        ActiveSheet.Sort.SortFields.Clear
        ActiveSheet.Sort.SortFields.Add Key:=Range("A" & i & ":D" & i), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveSheet.Sort
            .SetRange Range("A" & i & ":D" & i)
            .Header = xlGuess
            .MatchCase = False
            .Orientation = xlLeftToRight
            .SortMethod = xlPinYin
            .Apply
        End With
        Next
End Sub

Open in new window

0
 
MakriniCommented:
I am assuming you are wanting this incorporated in your original Macro so that it sorts the values in your selection - and then gives the differences?

Sub differences()
Dim Cell As Variant
Dim i As Long
Dim nums2(5)
    
For Each Cell In Selection
i = 0
newvalue = ""
    With Cell
        nums = Split(.Value, " ")
        
        nums = SortArray(nums)
        
        .Value = Join(nums, " ")
        For Each nvalue In nums
             If i > 0 Then
                If i > 1 Then
                    newvalue = newvalue & " " & nvalue - nums(i - 1)
                Else
                    newvalue = newvalue & nvalue - nums(i - 1)
                End If
            End If
            i = i + 1
        Next
        .Offset(0, 1).Value = newvalue
    End With
Next Cell
End Sub
Public Function SortArray(ByRef TheArray As Variant)
Sorted = False
Do While Not Sorted
    Sorted = True
For X = 0 To UBound(TheArray) - 1
    If TheArray(X) > TheArray(X + 1) Then
        Temp = TheArray(X + 1)
        TheArray(X + 1) = TheArray(X)
        TheArray(X) = Temp
        Sorted = False
    End If
Next X
Loop
SortArray = TheArray
End Function

Open in new window

0
 
keks_Author Commented:
Makrini thanks. I replaced the other code with the above but it doesn't work, meaning the result is not sorted. Any thoughts?
0
 
keks_Author Commented:
Is SortArray supposed to run automatically? Or do I run it somewhere?
0
 
MakriniCommented:
Sortarray should run automatically.  You simply run the usual Macro after selecting cells.  Can you attach your spreadsheet and I will have a look?
0
 
Saqib Husain, SyedEngineerCommented:
Try this macro. This is based on values in separate cells to be sorted horizontally row by row.

Sub SortIndivRows()
For i = Selection.Row To Selection.Row + Selection.Rows.Count
    Range(Cells(i, 1), Cells(i, 1).End(xlToRight)).Sort Key1:=Range("B" & i), Orientation:=xlLeftToRight
Next i
End Sub

Insert this macro in a new module. Select the rows which have to be sorted and run the macro.
0
 
MakriniCommented:
I am right though - you do want the values in a cell that are seperated by spaces - to be sorted in the cell itself right?
0
 
keks_Author Commented:
Makrini you're right - can you make your code work?
0
 
keks_Author Commented:
ssaqibh, I tried yours. My numbers are in column D. When I select it and I run it, it just switches values in column A with column B and vice versa.
0
 
Saqib Husain, SyedEngineerCommented:
In that case Makrini's code would be applicable. Mine was for values in separate cells.
0
 
MakriniCommented:
I can make mine work, but it is on mine.  Can you send me your spreadsheet and I will debug?
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
Hi guys!

Please check out my additional response in you question 35118568 (difference between two numbers).  :-)

Cheers
Chris (craisin)
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
Its me again.

I have incorporated the sorting as well as the "differences" into my code and run it successfully in Excel 2010

See my earlier instructions in question 35118568 re placing code in the VB Editor (macros).

Also attached (apart from updated code) is instructions on placing a user defined function on an Excel 2010 Spreadsheet.



Option Explicit

Public Function ValDiff(oCell As Range) As Variant
    
  'This function takes the values listed in a cell (oCell) and calculates the difference
  '(in sequence) of each number in the cell, listing the differences (again in order) in a different cell
  '(e.g. if cell "D2" contains the formula "=ValDiff(A2)" then the values calculated by this
  ' formula will be displayed in Cell D2
    
    'Parameter:  oCell - The address of the Cell being examined (e.g. A1)-do not use quotation marks
    '                    since this parameter is NOT a string
    
    Dim nVal As Integer          ' A Loop counter
    Dim nVals As Integer         ' The number of items in the cell under examination
    Dim nVals2 As Integer        ' Another Loop counter
    Dim cRet As String           ' A temporary holder for the value to eventually be returned by this function
    Dim cVals() As String        ' An array of the iyems listed in the "Host" cell (oCell)
    Dim cVals2() As String      ' A second array holding the values in cVals() but ignoring any "blank"
                                 ' values picked up due to too many spaces being used between charaters
    
    'First lets get the values from the reference cell, where the characters are seperated by a single space
    cVals = Split(oCell, " ")
    
    'Calculate the number of values found
    nVals = UBound(cVals)
    
    'We need to weed out values which were stored as "blank" because there where spaces
    'comprising of more than one "blank". This is in case user places two spaces (or more) between
    'characters instead of one.
    For nVal = 0 To nVals
      'ignore any values woth zero length
      If Len(cVals(nVal)) > 0 Then
        'keep track of the number of valid items found
        nVals2 = nVals2 + 1
        'redimension the new array to hold valid values
        ReDim Preserve cVals2(nVals2)
        
        'now store the latest valid value in the latest cell of the new array
        cVals2(nVals2) = cVals(nVal)
      End If
    Next
    
    cRet = ""
    'starting at the second valid value, go through each value in the new array
    For nVal = 2 To nVals2
      'and add to the cRet variable the numerical difference between the value being examined
      'the the value of the PREVIOUS item in the array of valid values.
      'Each new "difference" found is then seperated from the next by appending a "space" (" ")
      cRet = Trim(cRet + CStr(Val(cVals2(nVal)) - Val(cVals2(nVal - 1)))) + " "
    Next
    
    'Lets sort the values into ascending order first
    ValDiff = SortValues(cRet)

End Function

Public Function SortValues(cValues As String) As String
Dim Sorted As Boolean   'a flag to determine if any soirting has gone on
Dim x As Integer        'a counter 
Dim cArray() As String  ' a temporary array hlding "cValues" (values in cell)
Dim cTemp As String     ' a temp holding area for a string value 

'turn the values into an array
cArray = Split(cValues, " ")  

'while any sorting is still going on
Sorted = False
Do While Not Sorted
  Sorted = True  'assume it is sorted first
  For x = 0 To UBound(cArray) - 1
    If Val(cArray(x)) > Val(cArray(x + 1)) Then
      cTemp = cArray(x + 1)
      cArray(x + 1) = cArray(x)
      cArray(x) = cTemp
      'flag that it is still not fully sorted yet
      Sorted = False
    End If
  Next x
Loop

'turn the array back into a string
cTemp = ""
For x = 0 To UBound(cArray)
  cTemp = cTemp + cArray(x) + " "
Next
'and return the sorted string value back to the calling macro
SortValues = Trim(cTemp)
End Function

Open in new window

Macros-in-Excel-2010-9.jpg
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
In diagram 14 =, you cn click on the little square box to the right of the input field to select the field(s) you want.

Note! You can select more than one cell!

It now has the sorting incorporated as well as the extraction of the differences, all in one step.

It has been a great learning experience for me with Excel 2010.

Hope that is what you are after!  :-)

Chris
(craisin)

Macros-in-Excel-2010-10.jpg
Macros-in-Excel-2010-11.jpg
Macros-in-Excel-2010-12.jpg
Macros-in-Excel-2010-13.jpg
Macros-in-Excel-2010-14.jpg
Macros-in-Excel-2010-15.jpg
Macros-in-Excel-2010-16.jpg
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
In my commane above, it should read:

"In diagram 14 , you can click on the little square box to the right of the input field to select the Cell(s) you want......."etc. (sorry about that)  :-)

0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
I suddenly realised you may NOT want them sorted, or you may want them sorted "Forwards" or "Backwards"

I have revised the code to accommodate for this.

Simply 1. add "A" as a second argument if you want the sorted "Ascending"
           2. Add "D" as a second argument if you want them sorted "Descending"
           3. Leave second argument "blank" if you want them unsorted.

The revised code appears below and I attach an Excel 2010 Spreadsheet with everything on it.

Option Explicit

Public Function ValDiff(oCell As Range, Optional cOrder As String) As Variant
    
  'This function takes the values listed in a cell (oCell) and calculates the difference
  '(in sequence) of each number in the cell, listing the differences (again in order) in a different cell
  '(e.g. if cell "D2" contains the formula "=ValDiff(A2)" then the values calculated by this
  ' formula will be displayed in Cell D2
    
    'Arguments:  oCell - The address of the Cell being examined (e.g. A1)-do not use quotation marks
    '                   since this parameter is NOT a string
    '            cOrder - An optioanl argument to state whether the retunred string is to be in:
    '                     Ascending Order("A")
    '                     Descending Order ("D")
    '                     Unsorted (leave blank. i.e. no argument to be entered)
    
    Dim nVal As Integer          ' A Loop counter
    Dim nVals As Integer         ' The number of items in the cell under examination
    Dim nVals2 As Integer        ' Another Loop counter
    Dim cRet As String           ' A temporary holder for the value to eventually be returned by this function
    Dim cVals() As String        ' An array of the iyems listed in the "Host" cell (oCell)
    Dim cVals2() As String      ' A second array holding the values in cVals() but ignoring any "blank"
                                 ' values picked up due to too many spaces being used between charaters
    
    'First lets get the values from the reference cell, where the characters are seperated by a single space
    cVals = Split(oCell, " ")
    
    'Calculate the number of values found
    nVals = UBound(cVals)
    
    'We need to weed out values which were stored as "blank" because there where spaces
    'comprising of more than one "blank". This is in case user places two spaces (or more) between
    'characters instead of one.
    For nVal = 0 To nVals
      'ignore any values woth zero length
      If Len(cVals(nVal)) > 0 Then
        'keep track of the number of valid items found
        nVals2 = nVals2 + 1
        'redimension the new array to hold valid values
        ReDim Preserve cVals2(nVals2)
        
        'now store the latest valid value in the latest cell of the new array
        cVals2(nVals2) = cVals(nVal)
      End If
    Next
    
    cRet = ""
    'starting at the second valid value, go through each value in the new array
    For nVal = 2 To nVals2
      'and add to the cRet variable the numerical difference between the value being examined
      'the the value of the PREVIOUS item in the array of valid values.
      'Each new "difference" found is then seperated from the next by appending a "space" (" ")
      cRet = Trim(cRet + CStr(Val(cVals2(nVal)) - Val(cVals2(nVal - 1)))) + " "
    Next
    
    'Lets sort the balues into order if needed
    Select Case UCase(Left(cOrder, 1))
      Case "A"
        ValDiff = SortValues(cRet, "A")
      Case "D"
        ValDiff = SortValues(cRet, "D")
      Case Else
        'do nothing!
    End Select
    'return the value to be placed in Cell containing the function "ValDiff()"
    ValDiff = cRet
End Function

Public Function SortValues(cValues As String, Optional cOrder As String) As String
Dim Sorted As Boolean
Dim x As Integer
Dim cArray() As String
Dim cTemp As String
cArray = Split(cValues, " ")
Sorted = False
Do While Not Sorted
  Sorted = True
  Select Case UCase(Left(cOrder, 1))
    Case "A"
      For x = 0 To UBound(cArray) - 1
        If Len(cArray(x)) > 0 Then
          If IsGreaterThan(cArray(x), cArray(x + 1)) Then
            cTemp = cArray(x + 1)
            cTemp = cArray(x + 1)
            cArray(x + 1) = cArray(x)
            cArray(x) = cTemp
            Sorted = False
            Exit For
          End If
        End If
      Next x
    Case "D"
      For x = 0 To UBound(cArray) - 1
        If Len(cArray(x)) > 0 Then
          If IsLessThan(cArray(x), cArray(x + 1)) Then
            cTemp = cArray(x + 1)
            cArray(x + 1) = cArray(x)
            cArray(x) = cTemp
            Sorted = False
            Exit For
          End If
        End If
      Next x
    Case Else
      'do nothing!
  End Select
Loop
cTemp = ""
For x = 0 To UBound(cArray)
  cTemp = cTemp + cArray(x) + " "
Next
cValues = Trim(cTemp)
End Function

Private Function IsLessThan(cVal1 As String, cVal2 As String) As Boolean
  'This function tests whether the first value "IsLessThan" the second)
  'This first test does not need to be done (default)
  'If InStr(cVal1, "-") = 0 And InStr(cVal2, "-") > 0 Then
  '  IsLessThan = False
  If InStr(cVal1, "-") > 0 And InStr(cVal2, "-") = 0 Then
    IsLessThan = True
  ElseIf Val(cVal1) < Val(cVal2) Then
    IsLessThan = True
  End If
End Function

Private Function IsGreaterThan(cVal1 As String, cVal2 As String) As Boolean
  'This function tests whether the first value "IsGreaterThan" the second)
  'This first test does not need to be done (default)
  'If InStr(cVal1, "-") > 0 And InStr(cVal2, "-") = 0 Then
  '  IsLessThan = False
  If InStr(cVal1, "-") = 0 And InStr(cVal2, "-") > 0 Then
    IsGreaterThan = True
  ElseIf Val(cVal1) > Val(cVal2) Then
    IsGreaterThan = True
  End If
End Function

Open in new window

0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
Sorry...that was the WRONG file....I now attach the correct one!  Sorry.....
ValDiffs.xlsm
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
I can't get it to work ACROSS cells (i.e. the values from more than one cell) without a lot more work.

Do you only want the values from ONE referenced cell sorted , not combining cells then sorting, each time the function is placed in a cell?

If you do not want to combine cells, then my job is done!  :-)

Cheers
Chris
(craisin)
0
 
JoeNuvoCommented:
try below macro

to uses it
1) define shortcut key for this macro
2) select the range of data you want to perform sort
3) press your shortcut to called macro  OR call macro to run manually if you did not define shortcut

Sub SelectionSortHorizontal()
    Dim SelAdd() As String
    SelAdd = Split(Replace(Selection.Address, "$", ""), ":")
    Dim SelTop As Long, SelBottom As Long
    Dim SelLeft As Long, SelRight As Long
    SelTop = Range(SelAdd(0)).Row: SelBottom = Range(SelAdd(1)).Row
    SelLeft = Range(SelAdd(0)).Column: SelRight = Range(SelAdd(1)).Column
    
    Dim i As Long
    For i = SelTop To SelBottom
        Range(Cells(i, SelLeft), Cells(i, SelRight)).Select
    
        Selection.Sort Key1:=Range(Cells(Selection.Row, Selection.Column), Cells(Selection.Row, Selection.Column)), _
            Order1:=xlAscending, Orientation:=xlLeftToRight, _
            DataOption1:=xlSortNormal
    Next
    
    Range(Cells(SelTop, SelLeft), Cells(SelBottom, SelRight)).Select
End Sub

Open in new window

0
 
JoeNuvoCommented:
Remark :

I did not code it to allow whole column or whole row to be select.
if you want to do that as well, please let me know.
0
 
Chris Raisin(Retired Analyst/Programmer)Commented:
Do you have an answer to my question 35144265 above?
0
 
keks_Author Commented:
Sorry I have been pulled in another direction, let me close this, craisin wow you put a lot of work into this. Joe thanks for the answer but I believe craisin's is good
0

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 9
  • 5
  • 5
  • +4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now