Hi Ice,
Well my solution uses two filtering tables and a macro. So that adds 6 columns of formulas. You will need 2 named ranges, one defining the top of your listing and the other defining where to start outputting your vertical list.
Lets start with the first filter table.
Assuming your digits start in cells A2,B2,C2 and continue below, in cell E2, paste in the formula :- =IF(OR(A2=4,A2=5,A2=6),A2,0). Copy across to F2 and G2. You can copy this row of formulas down the page. This just filters out the non 4,5,6 keeping the remainder in order.
Now the ordering table:-
In cell I2 paste in the formula:- =LARGE($E2:$G2,3)
in cell J2 Paste in the formula:- =LARGE($E2:$G2,2)
in cell K2 paste in the formula:- =LARGE($E2:$G2,1)
You can copy this row of formulas down the page. So now all the required numbers remain in their sorted order, except for zeroes which need to be filtered out by the macro which scans this table row by row starting from the top. As it scans, it adds each digit it encounters to a string, and it does so until it reaches the bottom of the table.
So, to tell the macro where to start, you need to name the cell diagonally above and to the left above cell I3 (i.e cell H2) .."start"
Finally decide which column you want your output to appear in, and name the cell below which you wish to see your output. Name the cell "out".
Go to your VBA editor , find (or create) Module 1 and paste in this code:-
Option Explicit
Sub CollectDigits()
Dim numbers As String
Dim i, col, row, lastrow, numrows, n As Integer
Dim sht As Worksheet
Set sht = ThisWorkbook.Worksheets("Sheet1")
numbers = ""
Range("start").Select ' used rows are counted below this start point in the current table region
numrows = ActiveCell.CurrentRegion.Rows.Count
For row = 1 To numrows - 1
For col = 1 To 3
n = ActiveCell.Offset(row, col).Value
If n > 0 Then
numbers = numbers & n
End If
Next
Next
Range("out").Resize(10000, 1).Select
Selection.ClearContents
Range("out").Select
For i = 1 To Len(numbers)
ActiveCell.Offset(i, 0) = Mid(numbers, i, 1)
Next
Range("out").Select
End Sub
Note 1, you only need one "Option Explicit" at the top of the module. If there is already one in there, delete the one I used.
Note 2, the macro assumes that the sheet name you are using is Sheet 1. If your sheet has another name, change the Set sht = ThisWorkbook.Worksheets("Sheet1") to reflect the actual sheet name.
Note 3. Ive assumed the column you use for output is clear of data for 10000 cells downwards, as it deletes that range every time it writes. This could be edited if too large.
Now run the macro, you will need to do this every time you add new data. ( a button wuld help).
Limitations:- It re scans the list and rewrites the whole lot every time you run the macro, so it doesn't just add new digits to bottom the list. You have control of where it begins from and where it writes to, with named ranges.
Unlike formulas you cannot easily trace back from the output which row of data matches a number in the list. Not a problem with a short list, but with a long one, only the first and last ones are easy to relate to the source.
I hope this does the trick, let me know if there are problems,
Good Luck, Frank
