I have the numbers 1,2,3,4,5,6 in the source range("b4:g4") and would like to produce

1,2,3,4,5,6
2,3,4,5,6,1
3,4,5,6,1,2
4,5,6,1,2,3
5,6,1,2,3,4
6,1,2,3,4,5

Basically the code would take each number in the source range and place it in the 6th column if it is between 1 and 10 inclusive.
First it would have to the count how many numbers in the source range "b4:g4" are equal to and less than 10.
In this case the 6 numbers are less than 10 so it would produce 6 results. if it was 5 numbers that are less than 10 then it would produce 5 results. If all the numbers are more than 10 then no action is required.

The numbers in the source range can be in any order not necessarily in sequence.

Any help would be greatly appreciated.
Thank you

Hi Derick,

Am Thu, 22 Oct 2015 21:18:05 -0700 (PDT) schrieb
:

1,2,3,4,5,6
2,3,4,5,6,1
3,4,5,6,1,2
4,5,6,1,2,3
5,6,1,2,3,4
6,1,2,3,4,5

try:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
Application.ScreenUpdating = False
If myCnt = 6 Then
For i = 5 To 5 - 2 + myCnt
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next
Else
For i = 2 To 7
ReDim Preserve varData(myCnt - 1)
If Cells(4, i) < 11 Then
varData(n) = Cells(4, i)
n = n + 1
End If
Next
Range("B5").Resize(, UBound(varData) + 1) = varData
For i = 6 To 6 - 1 + UBound(varData)
Range(Cells(i, 2), Cells(i, 2 + UBound(varData))).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 2 +
UBound(varData))).Value
Cells(i, 2 + UBound(varData)) = Cells(i - 1, 2)
Next
End If
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Hi Derick,

Am Fri, 23 Oct 2015 08:20:48 +0200 schrieb Claus Busch:

try:

Sub Rearrange()

sorry, forgot the case if all numbers greater 10

Try:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
If myCnt = 0 Then Exit Sub

Application.ScreenUpdating = False

If myCnt = 6 Then
For i = 5 To 5 - 2 + myCnt
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next
Else
For i = 2 To 7
ReDim Preserve varData(myCnt - 1)
If Cells(4, i) < 11 Then
varData(n) = Cells(4, i)
n = n + 1
End If
Next
Range("B5").Resize(, UBound(varData) + 1) = varData
For i = 6 To 6 - 1 + UBound(varData)
Range(Cells(i, 2), Cells(i, 2 + UBound(varData))).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 2 +
UBound(varData))).Value
Cells(i, 2 + UBound(varData)) = Cells(i - 1, 2)
Next
End If
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Friday, October 23, 2015 at 1:40:37 AM UTC-5, Claus Busch wrote:
Hi Derick,

Am Fri, 23 Oct 2015 08:20:48 +0200 schrieb Claus Busch:

try:

Sub Rearrange()

sorry, forgot the case if all numbers greater 10

Try:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
If myCnt = 0 Then Exit Sub

Application.ScreenUpdating = False

If myCnt = 6 Then
For i = 5 To 5 - 2 + myCnt
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next
Else
For i = 2 To 7
ReDim Preserve varData(myCnt - 1)
If Cells(4, i) < 11 Then
varData(n) = Cells(4, i)
n = n + 1
End If
Next
Range("B5").Resize(, UBound(varData) + 1) = varData
For i = 6 To 6 - 1 + UBound(varData)
Range(Cells(i, 2), Cells(i, 2 + UBound(varData))).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 2 +
UBound(varData))).Value
Cells(i, 2 + UBound(varData)) = Cells(i - 1, 2)
Next
End If
Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Thank you. Its not quite doing what is expected.
For example:
If the numbers in the source range are;
1,2,3,4,12,13

Then the result should be:
2,3,4,12,13,1
3,4,12,13,1,2
4,12,13,1,2,3
12,13,1,2,3,4

Thank you

Hi Derick,

Am Fri, 23 Oct 2015 21:10:59 -0700 (PDT) schrieb
:

Thank you. Its not quite doing what is expected.
For example:
If the numbers in the source range are;
1,2,3,4,12,13

Then the result should be:
2,3,4,12,13,1
3,4,12,13,1,2
4,12,13,1,2,3
12,13,1,2,3,4

I thought you want only rearrange numbers <=10

Try this:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
If myCnt = 0 Then Exit Sub

Application.ScreenUpdating = False

For i = 5 To 9
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

On Saturday, October 24, 2015 at 1:20:31 AM UTC-5, Claus Busch wrote:
Hi Derick,


Thank you. Its not quite doing what is expected.
For example:
If the numbers in the source range are;
1,2,3,4,12,13

Then the result should be:
2,3,4,12,13,1
3,4,12,13,1,2
4,12,13,1,2,3
12,13,1,2,3,4

I thought you want only rearrange numbers <=10

Try this:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant

myCnt = Application.CountIf(Range("B4:G4"), "<11")
If myCnt = 0 Then Exit Sub

Application.ScreenUpdating = False

For i = 5 To 9
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
Next

Application.ScreenUpdating = True
End Sub


Regards
Claus B.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Very close
If the variable myCnt is equal to 4 then you should get 4 results, equals 5 then 5 results, myCnt dictates how many results. Any result should not have a value of more than 10 in the rightmost column.
I made the following adjustment, but am not sure if its the best approach:

Sub Rearrange()
Dim myCnt As Long, i As Long, n As Long
Dim varData() As Variant
Dim c as integer

c = 0

myCnt = Application.CountIf(Range("B4:G4"), "<11")
If myCnt = 0 Then Exit Sub

Application.ScreenUpdating = False

For i = 5 To 9
Range(Cells(i, 2), Cells(i, 6)).Value _
= Range(Cells(i - 1, 3), Cells(i - 1, 7)).Value
Cells(i, 7) = Cells(i - 1, 2)
c = c+1
if c = myCnt then Exit For

Next

Application.ScreenUpdating = True
End Sub

This smacks of lotto wheeling. Why not just use one of the many
wheeling algorithms available online?

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

explained on 23-10-15 :
I have the numbers 1,2,3,4,5,6 in the source range("b4:g4") and would like to
produce

1,2,3,4,5,6
2,3,4,5,6,1
3,4,5,6,1,2
4,5,6,1,2,3
5,6,1,2,3,4
6,1,2,3,4,5

Basically the code would take each number in the source range and place it in
the 6th column if it is between 1 and 10 inclusive. First it would have to
the count how many numbers in the source range "b4:g4" are equal to and less
than 10. In this case the 6 numbers are less than 10 so it would produce 6
results. if it was 5 numbers that are less than 10 then it would produce 5
results. If all the numbers are more than 10 then no action is required.

The numbers in the source range can be in any order not necessarily in
sequence.

Any help would be greatly appreciated.
Thank you

Try this:
================================
Public Sub ShiftLeft()
Dim A, B, C, R, i, j
Dim Separator As String

R = [F2!B4:G4]
Separator = ","

For Each i In R
A = A & i & Separator
Next
A = Left(A, Len(A) - 1)

MsgBox A
For j = 1 To 5
B = Split(A, Separator, -1, 1)
For i = 1 To 5
C = C & B(i) & Separator
Next
C = C & B(0)
MsgBox C
A = C
C = NullString
Next

End Sub
==============================

Bruno

On Sunday, October 25, 2015 at 7:32:49 PM UTC-5, Bruno Campanini wrote:

I have the numbers 1,2,3,4,5,6 in the source range("b4:g4") and would like to
produce

1,2,3,4,5,6
2,3,4,5,6,1
3,4,5,6,1,2
4,5,6,1,2,3
5,6,1,2,3,4
6,1,2,3,4,5

Basically the code would take each number in the source range and place it in
the 6th column if it is between 1 and 10 inclusive. First it would have to
the count how many numbers in the source range "b4:g4" are equal to and less
than 10. In this case the 6 numbers are less than 10 so it would produce 6
results. if it was 5 numbers that are less than 10 then it would produce 5
results. If all the numbers are more than 10 then no action is required.

The numbers in the source range can be in any order not necessarily in
sequence.

Any help would be greatly appreciated.
Thank you

Try this:
================================
Public Sub ShiftLeft()
Dim A, B, C, R, i, j
Dim Separator As String

R = [F2!B4:G4]
Separator = ","

For Each i In R
A = A & i & Separator
Next
A = Left(A, Len(A) - 1)

MsgBox A
For j = 1 To 5
B = Split(A, Separator, -1, 1)
For i = 1 To 5
C = C & B(i) & Separator
Next
C = C & B(0)
MsgBox C
A = C
C = NullString
Next

End Sub
==============================

Bruno

Very close. No result should have a value of more than 10 1n the rightmost column. Thank you