Thank You Bob and Scattered for your response but I looking for something
different. Maybe the information below is helpful.

I posted this question about two year ago and received a different answer.
The answer that I received had something to do with the following;
{=everynth(20, 3)}
This formula represent 20 numbers (1-20) listd by every 3 numbers. The VBA
is listed below:

Option Explicit

Function EveryNth(Num As Long, Nth As Long)
Dim i As Long
Dim j As Long
Dim k As Long
Dim x As Variant
Dim y As Variant

ReDim x(1 To Num)
For i = 1 To Num
x(i) = i
Next i
ReDim y(1 To Num)

i = 0
j = 0
k = 0

Do
i = i + 1
If i Num Then i = 1

If x(i) < 0 Then
k = k + 1
If k = Nth Then
j = j + 1
y(j) = x(i)
If j = Num Then Exit Do
x(i) = 0
k = 0
End If
End If
Loop
EveryNth = y

End Function

This is the Macro that I want to use. Please review, it's just not working
for me.

"scattered" wrote:

On Sep 17, 12:18 am, Floyd wrote:
What is the formula to arrange a set of numbers by a specific number.

Example, I have 1, 2, 3, 4, 5, 6, 7, 8, and 9.
I would like to arrange them by (3) every third number.

The answer would be:
3, 6, 9, 4, 8, 5, 2, 7, and then 1.

I'm not quite sure what you mean by "formula". What you are asking
about is related to the classic Josephus problem
http://en.wikipedia.org/wiki/Josephus_problem (which asks for the last
number listed) and even that is a fairly hard problem - so I don't
think a closed form solution which gives the full listing directly
without needing to actually step through the process is possible -
though I may be wrong there. Maybe you could post this in sci.math.

In any event, I wrote a VBA function which takes an array and a step
size and returns the array obtained by repeatedly stepping through the
remaining items according to the step size. I also include two test
routines (the first one to verify output, the second one a rough speed
test):

Function JosephusPermutation(A As Variant, stepSize As Long) As
Variant
Dim lower As Long, upper As Long
Dim i As Long, j As Long
Dim whereAt As Long, fromWhere As Long
Dim tempA As Variant, retA As Variant

lower = LBound(A)
upper = UBound(A)
ReDim tempA(lower To upper, 0 To 1)
ReDim retA(lower To upper)
For i = lower To upper
tempA(i, 0) = A(i)
tempA(i, 1) = i + 1
Next i
tempA(upper, 1) = lower
whereAt = lower
For i = lower To upper
For j = 1 To stepSize - 1 'walk
fromWhere = whereAt
whereAt = tempA(whereAt, 1)
Next j
retA(i) = tempA(whereAt, 0)
whereAt = tempA(whereAt, 1)
tempA(fromWhere, 1) = whereAt 'effectively removing item just
selected
Next i
JosephusPermutation = retA
End Function

Sub Test()
Dim A As Variant, skip As Long
Dim i As Long
Dim retString As String
A = Split(InputBox("Enter numbers, separated by spaces"))
skip = InputBox("Enter step size")
A = JosephusPermutation(A, skip)
For i = 0 To UBound(A)
retString = retString & " " & A(i)
Next i
retString = "Output:" & retString
MsgBox retString
End Sub

Sub Test2()
Dim A(1 To 10000) As Integer
Dim i As Long
For i = 1 To 10000
A(i) = i
Next i
Range("A1:A10000").Value =
Application.WorksheetFunction.Transpose(JosephusPe rmutation(A, 179))

End Sub


hth

-scattered