Formula to Sort Numbers

[MLewis123]

Here is a repost of a prior question.....certainly cleaned up!!

Cells:A2 - A800 are the clients names such as A2 = Client #1, A3=Clients #2
and so forth.

Cells: B1, C1, D1, and E1 are titled with labels: B1 = Extravert, C1 =
Intravert, D1 = Passive, and E1 is Other.

I created a survey where the client answers 1 to 4 for each of the labels.
For example, Client #1 on A2 enters 1 for Extravert, 2 for Intravert, 3 for
Other, and 4 for Passive; however, this is going to be on B2, C2, D2, and E2
respectively under each title.

What I need to do it create a formula that will keep the respective numbers
labels and put the numbers in order from least to greatest. There is a macro
where this data os put in a hierarchy triangle on a different workbook. So
the data triangle is going to be different for each client based on how they
responded to B2, C2, D2, and E2.

I hope this is clearer than my last post....

 

[Matthew Herbert]

MLewis123,

Can you be more specific as to how you want the data to be sorted? Are you
looking to sort the 4 columns for each client, placing the "sorted" output
off to the right (e.g. an output of Intravert:1, Other:2, Passive:3,
Extravert:4 in one cell to the right of the "Other" column)? Or are you
looking to somehow sort the columns (Extravert:Other) against one another
(maybe by using a column total) for all clients collectively? (I hope my
questions are clear).

Best,

Matthew Herbert

 

[MLewis123]

Thanks Matthew. The first part of your question is what I am looking for. I
can always add columns in for the data off to the right of the "other" such
as F2. All I want is the data in numerical order lowest 1 to highest 4 but
keeping the respective label. I am only interested in knowing the data for
the client who answered the question.

Hope that helps.

 

[Matthew Herbert]

MLewis123,

I have listed code below that utilizes Excel's native functionality. You
can tweek the code as necessary, but this should give you what you are
looking for. I wrote the code rather quickly, so test it to make sure it
works.

Best,

Matthew Herbert

Sub CustomSort()
Dim lngEnd As Long
Dim lngCnt As Long
Dim rngSort As Range
Dim rngLabel As Range
Dim rngCell As Range
Dim strText As String
Dim Wks As Worksheet
Dim wksSort As Worksheet

'create a worksheet object where the data resides
Set Wks = ThisWorkbook.Worksheets("Sheet1")

With Wks
'get the last row
lngEnd = .Range("A2").End(xlDown).Row
'get the column headers
Set rngLabel = .Range("B1:E1")
End With

'create a temp worksheet for using Excel's native sort
Set wksSort = ThisWorkbook.Worksheets.Add

'loop through each client
For lngCnt = 2 To lngEnd
With Wks
'set the range to sort
Set rngSort = .Range(.Cells(lngCnt, "B"), .Cells(lngCnt, "E"))
End With

With wksSort
'copy/paste-transpose the labels
rngLabel.Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
'copy/paste-transpose the values
rngSort.Copy
.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
'sort the labels and values by the values
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1")

'loop through the sorted set to create a string of label/values
For Each rngCell In .Range("A1").CurrentRegion.Cells
If rngCell.Column = 2 Then
strText = strText & rngCell.Value & ";"
Else
strText = strText & rngCell.Value & "="
End If
Next rngCell
End With

'remove the last ";" on the string
strText = Left(strText, Len(strText) - 1)

With Wks
'insert the string on the data sheet
.Cells(lngCnt, "F").Value = strText
'reset the string
strText = ""
End With
Next lngCnt

Application.DisplayAlerts = False
'delete the temporary worksheets
wksSort.Delete
Application.DisplayAlerts = True
End Sub

 

[MLewis123]

Matthew,

Good stuff so far. Works great. I would like to make a minor adjustment.

Is there a way that I can automatically add 4 columns with the results in
order? It appears that right now everything shows up in one cell. Also, I
do not need the equal sign and number, just the title in each of its own cell.

Any thoughts?

 

[Matthew Herbert]

MLewis123,

I'm not sure why I didn't think of this sooner, but a native Excel formula
will be MUCH faster than a macro; however, I did provide the adjusted macro
code below.

In addition to your aforementioned layout, place 1, 2, 3, 4 in cells F1, G1,
H1, and I1, respectively. In cell F2, place the following formula:

=INDEX($B$1:$E$1,MATCH(F$1,$B2:$E2,0))

Copy the formula to the right (through column I) and down (through the total
number of rows). This should return the result you are looking for without
having to use the macro, assuming that the values are integers only.

Best,

Matt

Sub CustomSort()
Dim lngEnd As Long
Dim lngCnt As Long
Dim rngSort As Range
Dim rngLabel As Range
Dim rngCell As Range
Dim Wks As Worksheet
Dim wksSort As Worksheet

'create a worksheet object where the data resides
Set Wks = ThisWorkbook.Worksheets("Sheet1")

With Wks
'get the last row
lngEnd = .Range("A2").End(xlDown).Row
'get the column headers
Set rngLabel = .Range("B1:E1")
End With

'create a temp worksheet for using Excel's native sort
Set wksSort = ThisWorkbook.Worksheets.Add

'loop through each client
For lngCnt = 2 To lngEnd
With Wks
'set the range to sort
Set rngSort = .Range(.Cells(lngCnt, "B"), .Cells(lngCnt, "E"))
End With

With wksSort
'copy/paste-transpose the labels
rngLabel.Copy
.Range("A1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
'copy/paste-transpose the values
rngSort.Copy
.Range("B1").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False
'sort the labels and values by the values
.Range("A1").CurrentRegion.Sort Key1:=.Range("B1")

'copy/paste-transpose the label results
.Range(.Range("A1"), .Range("A1").End(xlDown)).Copy
End With

Wks.Cells(lngCnt, "F").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False

Next lngCnt

Application.DisplayAlerts = False
'delete the temporary worksheets
wksSort.Delete
Application.DisplayAlerts = True
End Sub

 

[MLewis123]

You are such a great help...one small problem and I promise I will leave you
alone. The way the survey is setup is that a person could have multiple
responses of the same number in any of the cells, so there might be times
where there are two 4's or 3 3's, etc. Any thoughts? I thought about
rounding, but the match statement requires actuals and it will not fill in
duplicates. Last question!!!!

 

[Matthew Herbert]

MLewis123,

I'll have to think a bit more about a function that might do the trick.
(Quite honestly, it will probably take me longer to come up with a function,
if there is a combination of functions that will make this work, than to use
the macro below). Stick with the macro for now. The macro will sort the
values regardless of whether there are 3 3s, 2 2s, or any combination of
numbers. (If you have a tie with 2 2s, for example, then you'll have to
provide more detail as to how you want the labels to be ordered). Add the
following line after the last Dim statement (i.e. after Dim wksSort As
Worksheet) to help "speed" things up:

Application.ScreenUpdating = False

Best,

Matthew Herbert

 

[MLewis123]

Hey Matt,

The macro works perfectly for what I need. No need to think any
further....you were awesome on this. There seems to be a little issue, for
some reason if I create a new worksheet the macro works fine, but if I use my
current worksheet I get an error that says it cannot paste because cells are
not same size. No cell is merged and no cell is different size. Not sure if
you can help with that. I did do another post to see if I can get answer on
that because I feel bad for asking for additional help from you, you have
done so much for me.

 

[MLewis123]

Got it fixed....little error on my part.....Thanks so much!!!