redistributing numbers in excel

  • Thread starter Thread starter tx12345
  • Start date Start date
T

tx12345

Hi,

I am not sure how to phrase this, but I will give an example.

I have a set of numbers clumped together in one worksheet named W1,
that looks like this:

___ a b c d e f
1___2 3 4 5 6
2___1 2 3 4 5
3___5 6 6 7 7

etc

Pretty simple so far? OK great. NOW comes the hard part (for me at
least)

on a second worksheet, W2, i have a set of cells set up to receive the
numbers just shown. but i want all the 4s to go in one slot, all the 5s
to go in another, all the 2s in another, and so on. So i want to be
able to draw out of the original set (as i input into the original cell
sector on W1) and have the numbers magicaly appear in the other
worksheet, W2, as follows:

__a b c d e f g h i (etc)
1 1 2 3 4 5 6 7
2__2 3 4 5 6 7
3_______5 6
4
5
6

SO all the 7s go into the '7' column, the 2s into the '2's column, etc.
once one cell gets, let's say one 7, then it knows to go to the next
cell, draw out the next 7 in the set of numbers on W1 and place it in
the next cell below the last 7.

I know there is a really LONG way of doing this by sorting, cutting and
pasting, but maybe there is a simple macro, or better, some sort of
function that can pull this off. Anyway, any tips would really be
appreciated!

Thanks
 
try this macro

Sub Macro1()
' clear old results off of sheet W@
Sheets("W2").Select
Range("A1:IV1000").ClearContents
'limit size of data to 100 rows, 100 columns
Dim data(100, 100) As Integer
Sheets("W1").Select
'
'assume data starts in cell a1
'
lastrow = Cells(1000, 1).End(xlUp).Row
lastcol = Cells(1, 1).End(xlToRight).Column
'read data into data(i,j)
For i = 1 To lastrow
For j = 1 To lastcol
data(i, j) = Cells(i, j).Value
Next j
Next i
Sheets("W2").Select
For i = 1 To lastrow
For j = 1 To lastcol
k = data(i, j)
Cells(1000, k).End(xlUp).Offset(1, 0) = k
Next j
Next i
Cells(1, 1).EntireRow.Delete
End Su
 
a little neater and protection from a zero value

Sub Macro1()
' clear old results off of sheet W2
Sheets("W2").Select
Range("A1:IV1000").ClearContents
'limit size of data to 100 rows, 100 columns
Dim data(100, 100) As Integer
Sheets("W1").Select
'
'assume data starts in cell a1
'
lastrow = Cells(1000, 1).End(xlUp).Row
lastcol = Cells(1, 1).End(xlToRight).Column
Sheets("W2").Select
For i = 1 To lastrow
For j = 1 To lastcol
k = Sheets("W1").Cells(i, j).Value
If k <= 0 Then GoTo nextj
Cells(1000, k).End(xlUp).Offset(1, 0) = k
nextj:
Next j
Next i
Cells(1, 1).EntireRow.Delete
End Sub
 
Back
Top