order cells under corresponding column

[asddsa88]

Not an easy one:

I have a dataset which I need to reorder through a macro.

----------------------------------------------
A ......B ......C ...... D ......E ...... ...... ...... ---> main spreadsheet columns

a b c ...... ...... ...... ...... ...... ...... ...... .. ---> data set (each letter represents a cell with a given value)

c e ...... ...... ...... ...... ...... ...... ...... .....---> data set

f ...... ...... ...... ...... ...... ...... ...... ...... .---> data set
----------------------------------------------

I want the macro to position the data set according to the main columns' value, the sorting rule should be:

if the cell value = main column value, then position that cell under that column. Otherwise leave it where it is.

the intial example should become in this case:
----------------------------------------------
A ......B ......C ...... D ......E ...... ...... ....---> main columns

a ..... b ......c ...... ...... ...... ...... ...... . ---> each cell has been repositioned under the corresponding column

..................c................ e ...... ...... ....---> each cell has been repositioned under the corresponding column
f ...... ...... ...... ...... ...... ...... ...... ......---> this cell had no corresponding column, so it has been left where it was!
----------------------------------------------
any suggestions please?

[Atravis]

This should re-order the values. It just maps the rows and values in an array, clears the sheet and writes the new data back in.

[VBA]Sub ReOrder_Cells()
Dim s1 As Worksheet, Cells_Used As Double, c As Range
Set s1 = Worksheets("Sheet1")
'find how many cells have values
Cells_Used = WorksheetFunction.CountA(s1.UsedRange.Cells)
'set up array to hold new co-ordinates
Dim arr()
ReDim arr(Cells_Used - 1, 1)
'for each cell with value map row and new column(which is the value)
i = 0
For Each c In s1.UsedRange.Cells
If c <> "" Then
arr(i, 0) = c.Row
arr(i, 1) = c.Value
i = i + 1
End If
Next
'clear all old data
s1.Cells.Clear
'loop in new values (on error resume next to handle any values that are not Column names)
For i = 0 To UBound(arr)
On Error Resume Next
s1.Cells(arr(i, 0), CStr(arr(i, 1))) = arr(i, 1)
On Error GoTo 0
Next
End Sub
[/VBA]

[asddsa88]

thank you very much for the code!

I did a test, if I used single characters in the cell values (like in my previous example) everything worked.

But when I used multiple letters in the cells (which is actually what I need) then it just gave me a blank sheet!

any ideas on how to fix that?

[Atravis]

This should do it. have changed how the array is sized and put in a loop for each character in populated cells.

[vba]Sub ReOrder_Cells()
Dim s1 As Worksheet, Cells_Used As Double, c As Range
Set s1 = Worksheets("Sheet1")

'set up array to hold new co-ordinates
Dim arr()
ReDim arr(1, 0)
'for each cell with value map row and new column(which is the value)
For Each c In s1.UsedRange.Cells
If c <> "" Then
'loop through each character
For j = 1 To Len(c.Value)
arr(0, UBound(arr, 2)) = c.Row
arr(1, UBound(arr, 2)) = Mid(c.Value, j, 1)
'increase arr size
ReDim Preserve arr(1, UBound(arr, 2) + 1)
Next j
End If
Next
'clear all old data
s1.Cells.Clear
'loop in new values (on error resume next to handle any values that are not Column names)
For i = 0 To UBound(arr, 2)
On Error Resume Next
s1.Cells(arr(0, i), CStr(arr(1, i))) = arr(1, i)
On Error GoTo 0
Next
End Sub[/vba]

[asddsa88]