Help with an Excel macro please?

[Victor Delta]

I have a spreadsheet with a sequence of 6 random numbers in cells A1 to
A6. I would like to create a macro which copies the sequence down column
B (i.e. cells B1 to B6), then recalculates the random numbers and copies
the new sequence down the next 6 cells of column B, and so on until it
has filled x cells in this way - where x is determined by the number in
cell C1.

I know I could simply fill column B with random numbers directly but
have a particular reason for wanting to do it as described above.

I'd really appreciate any help anyone can give me with this.

Many thanks.

 

[Claus Busch]

Hi,

Am Sat, 26 Apr 2014 20:04:55 +0100 schrieb Victor Delta:

I have a spreadsheet with a sequence of 6 random numbers in cells A1 to
A6. I would like to create a macro which copies the sequence down column
B (i.e. cells B1 to B6), then recalculates the random numbers and copies
the new sequence down the next 6 cells of column B, and so on until it
has filled x cells in this way - where x is determined by the number in
cell C1.

try:

Sub Randomize()
Dim arrOut As Variant
Dim LRow As Long
Dim myRows As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
myRows = .Range("C1")
Do
arrOut = .Range("A1:A6")
LRow = .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
.Range("B" & IIf(LRow = 2, 1, LRow)).Resize(rowsize:=6) = arrOut
.Calculate
Loop While LRow + 6 < myRows
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

 

[Claus Busch]

Hi,

Am Sun, 27 Apr 2014 08:55:56 +0200 schrieb Claus Busch:

try:

Sub Randomize()

if you want to fill the exact number of rows like shown in C1 try:

Sub Randomize()
Dim arrOut As Variant
Dim LRow As Long
Dim myRows As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
myRows = .Range("C1")
Do
LRow = .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
arrOut = .Range("A1:A" & WorksheetFunction.Min(6, myRows - LRow
+ 1))
.Range("B" & IIf(LRow = 2, 1, LRow)) _
.Resize(rowsize:=UBound(arrOut)) = arrOut
.Calculate
Loop While LRow + 6 < myRows
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

 

[Victor Delta]

Hi,

Am Sun, 27 Apr 2014 08:55:56 +0200 schrieb Claus Busch:


if you want to fill the exact number of rows like shown in C1 try:

Sub Randomize()
Dim arrOut As Variant
Dim LRow As Long
Dim myRows As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
myRows = .Range("C1")
Do
LRow = .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
arrOut = .Range("A1:A" & WorksheetFunction.Min(6, myRows - LRow
+ 1))
.Range("B" & IIf(LRow = 2, 1, LRow)) _
.Resize(rowsize:=UBound(arrOut)) = arrOut
.Calculate
Loop While LRow + 6 < myRows
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

Claus

Many thanks. I'll give these a go and let you know how I get on.

V

 

[Victor Delta]

Hi,

Am Sun, 27 Apr 2014 08:55:56 +0200 schrieb Claus Busch:


if you want to fill the exact number of rows like shown in C1 try:

Sub Randomize()
Dim arrOut As Variant
Dim LRow As Long
Dim myRows As Long

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
myRows = .Range("C1")
Do
LRow = .Cells(Rows.Count, "B").End(xlUp).Offset(1, 0).Row
arrOut = .Range("A1:A" & WorksheetFunction.Min(6, myRows - LRow
+ 1))
.Range("B" & IIf(LRow = 2, 1, LRow)) _
.Resize(rowsize:=UBound(arrOut)) = arrOut
.Calculate
Loop While LRow + 6 < myRows
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

Claus

Your second macro works perfectly, thank you so much.

However, there is one final modification I would like to make if it's
possible. Rather than copying the sets of numbers straight down column
B, I would like to only copy them to those rows where the cells of
column E contain a 'Y'. So if C1 was 15, the 15 numbers might actually
be spread down a much greater number of rows.

Hope this makes sense and many thanks if you can tell me how to do this.

V

 

[Claus Busch]

Hi,

Am Mon, 28 Apr 2014 21:14:21 +0100 schrieb Victor Delta:

However, there is one final modification I would like to make if it's
possible. Rather than copying the sets of numbers straight down column
B, I would like to only copy them to those rows where the cells of
column E contain a 'Y'. So if C1 was 15, the 15 numbers might actually
be spread down a much greater number of rows.

try:

Sub Randomize()
Dim i As Long, n As Long
Dim c As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
i = 1
Set c = .Range("E:E").Find("Y", after:=.Range("E1"), _
LookIn:=xlValues, LookAt:=xlWhole)
Do
c.Offset(0, -3) = .Cells(i, 1)
i = i + 1
n = n + 1
If i = 7 Then
.Calculate
i = 1
End If
Set c = .Range("E:E").FindNext(c)
Loop While n < 15
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

 

[Victor Delta]

Hi,

Am Mon, 28 Apr 2014 21:14:21 +0100 schrieb Victor Delta:


try:

Sub Randomize()
Dim i As Long, n As Long
Dim c As Range

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

With ActiveSheet
i = 1
Set c = .Range("E:E").Find("Y", after:=.Range("E1"), _
LookIn:=xlValues, LookAt:=xlWhole)
Do
c.Offset(0, -3) = .Cells(i, 1)
i = i + 1
n = n + 1
If i = 7 Then
.Calculate
i = 1
End If
Set c = .Range("E:E").FindNext(c)
Loop While n < 15
End With

With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub


Regards
Claus B.

Claus

You are a star. Very many thanks,

V