PDA

View Full Version : Solved: Horizontal Sorting



maestro_01
08-03-2010, 07:41 AM
Hello,

I have a column I need to sort horizontally. The catch? It is grouped by a category in the adjacent column so for example:

A,1
A,2
A,3
B,4
B,5

Will need to be:

A,1,2,3
B,4,5

How would I go about doing this?

Thanks

GTO
08-03-2010, 07:43 AM
Greetings,

Your sample data only shows transposing by category. Does there need to be a Sort as well?

maestro_01
08-03-2010, 08:41 AM
Thanks GTO,

Not exactly Transpose, transpose would make column A-row 1 and column B-row 2. I would still need to keep column A, but horizontal sort column B based on the values in column A.

GTO
08-04-2010, 03:42 AM
Maybe I am being more thick-headed than usual, but I am still not following exactly. "horizontal sort column B...." makes no sense.

Please attach a workbook. On Sheet1 list the data how it should look 'Before' and 'After' on another sheet.

In the 'Before' view, please don't have stuff listed 1,2,3, A,B,C, but random. This way, we could tell what the sort is actually supposed to do.

Thanks,

Mark

maestro_01
08-04-2010, 06:00 AM
Thanks GTO - much appreciated.

Please see attached, I named sheet 1 "Before Sort" and sheet 2 is named "After".

GTO
08-04-2010, 12:06 PM
In a Standard Module:

Option Explicit

Sub exa()
Dim _
rngData As Range, _
aCats As Variant, _
CatVal As Variant, _
aryOutput As Variant, _
i As Long, _
ii As Long, _
x As Long, _
blnEmptySlotExists As Boolean

'// change first/top row to suit//
Const FIRST_ROW As Long = 1

'// Set a reference to the first column / the categories //
With Sheet1 'ThisWorkbook.Worksheets("BEFORE SORT")
Set rngData = .Range(.Cells(FIRST_ROW, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With

'// Fill a 1 to x by 1 to 1 array with the values. //
aCats = rngData.Value

'// Create a Dictionary and ... //
With CreateObject("Scripting.Dictionary")
'// ...fill it with unique values from the first column. We will use this //
'// collection to tack in values belonging to each category. //
For Each CatVal In aCats
.Item(Key:=CatVal) = Empty
Next

'// Initially change our collection of categeories into an array where the //
'// first column holds the category names. //
aryOutput = Application.Transpose(.Keys)

'// Re-use aCats to now hold both columns values. //
aCats = rngData.Resize(, 2).Value

'// .Count will be the same as UBound(aryOutput, 1). Outer loop runs thru our //
'// collection... //
For i = 1 To .Count
'// ...inner loop runs thru first column... //
For ii = LBound(aCats, 1) To UBound(aCats, 1)
'// ...and if the cell matches the current item in the first column of //
'// our aoutput array... //
If aCats(ii, 1) = aryOutput(i, 1) Then
'// then we run thru the columns in the correct row of the array, to//
'// see if we have an empty element. //
For x = 1 To UBound(aryOutput, 2)
If IsEmpty(aryOutput(i, x)) Then
'// If we find an empty element, tack in the val there. //
aryOutput(i, x) = aCats(ii, 2)
blnEmptySlotExists = True
Exit For
End If
Next

'// If we didn't find an empty element, we need to resize the array //
'// to hold the match. //
If Not blnEmptySlotExists Then
ReDim Preserve aryOutput(1 To .Count, 1 To UBound(aryOutput, 2) + 1)
aryOutput(i, UBound(aryOutput, 2)) = aCats(ii, 2)
Else
blnEmptySlotExists = False
End If
End If
Next
Next
End With

'// plunk the output wherever... //
With ThisWorkbook.Worksheets.Add(After:=rngData.Parent).Range("A2") _
.Resize(UBound(aryOutput, 1), UBound(aryOutput, 2))

.Value = aryOutput
.EntireColumn.AutoFit
.Parent.Name = "MY AFTER"
End With
End Sub

Hoep that helps,

Mark

maestro_01
08-04-2010, 04:43 PM
Thanks so much GTO, it sorts perfectly! I just have one more question, if the sorted data (the names) have conditional formatting based on data in other column, how would I be able to copy over the conditional formatting?

Thanks Again!