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