Solved

Excel97 - VBA to sort selected range

Posted on 2002-03-27
12
976 Views
Last Modified: 2012-06-27
I would like to be able to run some VBA that would sort a range of data - I potentially may have several more columns of data I require sorting over and above Excel's standard 3 column sort. I know it is possible to overcome the 3 column sort limitation by performing sorts within sorts BUT it's a hassle.
What I would like is some VBA to do the following -
display a pop-up screen for the user to specify the data range.
The VBA would then sort the data (vertically) across columns left to right in ascending order.
Assume no header rows. The tricky bit is catering for different numbers of columns for the sort depending on the range selected. It would also be good if the user had the ability to return the data to its original unsorted state. I guess the best solution would be to offer the user the choice of overwriting the existing data or creating a new data range for the sorted data - this would remove the hassle of getting the data back to its original state.
0
Comment
Question by:BlueFin
  • 3
  • 3
  • 3
  • +1
12 Comments
 
LVL 44

Expert Comment

by:bruintje
ID: 6899598
Hi BlueFin,

so you would like a replacement for the current dialog?
with the possibillity of a nested (3+ levels) sort?

:O)Bruintje
0
 
LVL 44

Expert Comment

by:bruintje
ID: 6901169
I found some entries in the excel newsgroup

from David McRitchie

Say you want to sort on Columns  A, B, C, D , E   with A
being the most major.   Sort on  C, D, E  then on A, B.
If you have to do this a lot you can record a macro.

from Harlan Grove

As others have pointed out, you could sort the same range multiple times if
you want to rely on Excel remembering previous sorts. One alternative is
creating an additional column holding a composite sort key. If your columns
A and C were numeric and B and D were text, then enter the formula

=TEXT(A1,"+0000000000;-0000000000")
&B1&REPT(" ",256-LEN(B1))
&TEXT(C1,"+0000000000;-0000000000")
&D1&REPT(" ",256-LEN(D1))

into X1 and fill this formula into X2:X100. Then sort A1:X100 on column X.
Finally clear X1:X100

I'm not sure how to post solutions found in other resources like newsgroups that's why i posted their names. Of course NOW i know how to do it but i didn't till i found these entries but that's how we get the answers to our tech questions these days find the solution implement the code and share it on the biggest open source codebook the internet!

HTH:O)Bruintje
0
 
LVL 13

Expert Comment

by:WJReid
ID: 6901880
Hi BlueFin,

To display an InputBox allowing the user to specify the range, use:

Sub FindRange()
Dim List As Range
Set List = Application.InputBox(prompt:="Select Range Required", Type:=8)
List.Select
End Sub
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 13

Expert Comment

by:WJReid
ID: 6901888
Hi BlueFin,

To get the list back to its original state, you could put a column to the left of the list numbered ascendingly from 1. The user could then select the range to be brought back to the original state using the sub FindRange code and sort on this column.

Regards,

Bill
0
 

Expert Comment

by:gkost
ID: 6905146
Dear BlueFin

Check this out ... this a litte code I made for you :-)

you can add it to the "declarations" section of your projects. The user interface is not so friendly but the
code operates pretty well.
You can modify the code tand use "ranges" instead of "cells" but the main idea remains the same:

"sort backwars..."

Here you are :


-----------------------------------------------------
Sub sort_me()
Dim startc, endc, upcell, downcell As Integer

startc = InputBox("give start column (A=1)")
endc = InputBox("give final column (A=1)")
upcell = InputBox("give first cell ")
downcell = InputBox("give last cell")

For i = endc - 1 To startc Step -1
   
'Range(Cells(upcell, i), Cells(downcell, endc)).Select
    Range(Cells(Int(upcell), i), Cells(Int(downcell), Int(endc))).Select
    Selection.Sort Key1:=Cells(1, i), Order1:=xlAscending, Key2:=Cells(1, i + 1) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next

End Sub
-----------------------------------------------
Hope you find it helpful

All the best
Gkost
0
 

Author Comment

by:BlueFin
ID: 6912409
Thanks for the help gkost - unfortunately your code is not working correctly. The following
a     c     h
a     d     j
a     c     h
a     c     g
b     e     l
b     f     n
b     e     k
a     c     g
a     d     j
b     f     n
a     d     i
a     d     i
b     f     m
b     f     m
b     e     l
b     e     k
should end up after sorting like this
a     c     g
a     c     g
a     c     h
a     c     h
a     d     i
a     d     i
a     d     j
a     d     j
b     e     k
b     e     k
b     e     l
b     e     l
b     f     m
b     f     m
b     f     n
b     f     n
Your code produces this
a     c     g
a     c     g
a     c     h
a     c     h
a     d     j
a     e     k
a     e     l
a     e     l
b     d     i
b     d     i
b     d     j
b     e     k
b     f     m
b     f     m
b     f     n
b     f     n
0
 

Expert Comment

by:gkost
ID: 6912561
No prob BlueFin!
Just a small adjustment required :

   Range(Cells(Int(upcell), Int(startc)), ......

instead of

   Range(Cells(Int(upcell), i), .......


The full code is given hereafter.
Check it out and let me know !
I guess this time we are ok ...




Sub sort_me()
Dim startc, endc, upcell, downcell As Integer

startc = InputBox("give start column (A=1)")
endc = InputBox("give final column (A=1)")
upcell = InputBox("give first cell ")
downcell = InputBox("give last cell")

For i = endc - 1 To startc Step -1
   
   Range(Cells(Int(upcell), Int(startc)), Cells(Int(downcell), Int(endc))).Select
   Selection.Sort Key1:=Cells(1, i), Order1:=xlAscending, Key2:=Cells(1, i + 1) _
       , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next

End Sub
0
 

Author Comment

by:BlueFin
ID: 6920549
qkost
Thanks for the updated code - it seems to be working OK.
I would like a better user interface though, as I would like others to use this code too.
E.G. if you have a range starting in colK it is difficult to work out that this is the 11th column.
Is it possible to somehow get VBA to work out the column and row numbers by specifying the range? Failing this, could the user not specify the first cell and last cell of the range? i.e.could the VBA derive from the first cell reference - the beginning column and row numbers - and then derive from the last cell reference the ending column and row numbers. I will increase the points to 250 if you can do this.
Thanks
0
 
LVL 44

Expert Comment

by:bruintje
ID: 6920566
you could also use a userform for this

-just add the boxes for input (bit tricky with user input has to be ranges)
-and add buttons to execute the code

-got no time to do it although it's quite simple
-but i guess that gkost can add that to the already provided solution

:O)Bruintje
0
 
LVL 13

Expert Comment

by:WJReid
ID: 6920580
HiBlueFin,

The input box I suggested earlier would allow the user to select a range and this could be used with gkost's solution.
0
 

Accepted Solution

by:
gkost earned 175 total points
ID: 6920851
Dear Bluefin,

I made a slight modification and I think we are ok!
So, now there is only one input box and all you have to enter is just the range you are interested in, (e.g. A1:F20).

Voila :
---------------------------------------------------------
Sub sort_me()

Dim sc, ec, rnd As String
Dim endc, startc, l As Integer


rng = InputBox("Give Range (e.g A1:E10)")
rng = Trim(rng)
l = Len(rng)
sc = Left$(rng, InStr(rng, ":") - 1)
ec = Right$(rng, l - InStr(rng, ":"))

startc = Range("a1:" & sc).Columns.Count
endc = Range("a1:" & ec).Columns.Count

Range(rng).Select

For i = endc - 1 To startc Step -1
  Selection.Sort Key1:=Cells(1, i), Order1:=xlAscending, Key2:=Cells(1, i + 1) _
      , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next

End Sub


Best regards,

George
0
 

Author Comment

by:BlueFin
ID: 6924835
George
Thanks for the code - it looks like I'm getting there - the data sorts OK BUT I need a bit of error control on the input box. I tried entering a range name rather than the co-ordinates and the code errored with "invalid procedure call or arguement"
at the line
sc = Left$(rng, InStr(rng, ":") - 1)
Is there some way to test what the user has put in - if it is not cell co-ordinates then the user gets the message "invalid range - please enter cell co-ordinates".
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now