Thanks, Don. You macro worked. But I just realized that the cells in
columns A thru D actually contain more data than just the number. For
example;
Col A contains:
1 xxxxxxx
5 yyyyyyyyyyyyyy
7 xxxxxxx
10 yyyyyyyyyyyyyy
14 zzz
Col B contains:
2 yyyyyyyyyyyyyy
3 xxxxxxx
6 zzz
Col C contains:
4 xxxxxxx
6 yyyyyyyyyyyyyy
8 xxxxxxx
11 zzz
13 xxxxxxx
Col D contains:
1 yyyyyyyyyyyyyy
5 yyyyyyyyyyyyyy
8 xxxxxxx
9 zzz
10 xxxxxxx
12 xxxxxxx
13 xxxxxxx
14 yyyyyyyyyyyyyy
15 xxxxxxx
How do I put the number plus its other data from the FIRST column it
occurred in into Col E? For example:
1 xxxxxxx (came from Col A)
2 yyyyyyyyyyyyyy (came from Col B)
3 xxxxxxx (came from Col B)
4 xxxxxxx (came from Col C)
5 yyyyyyyyyyyyyy (came from Col A)
6 yyyyyyyyyyyyyy (came from Col B)
7 xxxxxxx (came from Col A)
8 xxxxxxx (came from Col C)
9 zzz (came from Col D)
10 yyyyyyyyyyyyyy (came from Col A)
11 zzz (came from Col C)
12 xxxxxxx (came from Col D)
13 xxxxxxx (came from Col C)
14 zzz (came from Col A)
15 xxxxxxx (came from Col D)
Assuming
your data starts in A1 and occupies the first four columns
Each valid entry starts with a series of digits
you want the output in numeric order
you are not interested in the column source as part of the output
Try this macro:
================================
Option Explicit
Sub ReturnByColumn()
Dim vSrc As Variant, vRes() As String
Dim LastRow As Long
Dim coll As Collection
Dim i As Long, j As Long
For i = 1 To 4 'check columns A-D
j = Cells(Rows.Count, i).End(xlUp).Row
If j > LastRow Then LastRow = j
Next i
vSrc = Range(Cells(1, 1), Cells(LastRow, 4))
Set coll = New Collection
On Error Resume Next
For i = 1 To UBound(vSrc, 1)
For j = 1 To UBound(vSrc, 2)
If Not IsEmpty(vSrc(i, j)) And Val(vSrc(i, j)) > 0 Then _
coll.Add Item:=vSrc(i, j), Key:=CStr(Val(vSrc(i, j)))
Next j
Next i
On Error GoTo 0
i = 1: j = 1
ReDim vRes(1 To coll.Count, 1 To 1)
Do Until j > coll.Count
On Error GoTo NoKey
vRes(j, 1) = coll(CStr(i))
j = j + 1: i = i + 1
Loop
On Error GoTo 0
Range("E1").EntireColumn.ClearContents
Range("E1", Cells(UBound(vRes, 1), "E")) = vRes
Exit Sub
NoKey: If Err.Number = 5 Then
j = j - 1
Resume Next
Else
MsgBox ("Error: " & Err.Number & vbLf & Err.Description)
End If
Stop
End Sub
========================================
