Help with an Excel macro please?
 

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.

Help with an Excel macro please?
 

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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Help with an Excel macro please?
 

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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Help with an Excel macro please?
 

In article ,
says...

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.

Claus

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

V

Help with an Excel macro please?
 

In article ,
says...

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.

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

Help with an Excel macro please?
 

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.
--
Vista Ultimate / Windows7
Office 2007 Ultimate / 2010 Professional

Help with an Excel macro please?
 

In article ,
says...

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.

Claus

You are a star. Very many thanks,

V