Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Why does this coding not work?

Hello.

I have produced the following coding, but for the range which is
selected beforehand, it coding only covers some of the range, not all
of it?

any ideas? (Has to be with option explicit on)

Sub nextgeneration()

Private rng As Range
Private cell As Range

Dim rcount As Integer
Dim ccount As Integer

On Error Resume Next
Dim Arr()
rng.Select
rcount = Selection.Rows.count
ccount = Selection.Columns.count

ReDim Arr(rcount, ccount)

Dim count As Integer

For Each cell In Selection
count = 0
Range(cell.Address).Activate

count = count + ActiveCell.Offset(1, -1).Value
count = count + ActiveCell.Offset(1, 0).Value
count = count + ActiveCell.Offset(1, 1).Value
count = count + ActiveCell.Offset(0, -1).Value
count = count + ActiveCell.Offset(0, 1).Value
count = count + ActiveCell.Offset(-1, -1).Value
count = count + ActiveCell.Offset(-1, 0).Value
count = count + ActiveCell.Offset(-1, 1).Value

If cell.Value = 1 Then
Select Case count
Case Is < 2
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Is 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
End Select
Else
Select Case count
Case Is = 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
End Select
End If
Next cell

Dim rval As Integer
Dim cval As Integer

For Each cell In Selection
rval = cell.Row - 3
cval = cell.Column - 2
Range(cell.Address).Value = Arr(rval, cval)
Select Case cell.Value

End Select
Next cell

rng.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="1"
Selection.FormatConditions(1).Interior.ColorIndex = 1
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = 2

Range("B1").Value = Range("B1").Value + 1
Range("a1").Select
End Sub

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 486
Default Why does this coding not work?

You need to initialize your range objects. If you want rng to be equal to the
selected range then use something like this...

set rng = activesheet.selection
not
rng.Select

which will fail because you have not defined rng yet...
--
HTH...

Jim Thomlinson


"rammieib" wrote:

Hello.

I have produced the following coding, but for the range which is
selected beforehand, it coding only covers some of the range, not all
of it?

any ideas? (Has to be with option explicit on)

Sub nextgeneration()

Private rng As Range
Private cell As Range

Dim rcount As Integer
Dim ccount As Integer

On Error Resume Next
Dim Arr()
rng.Select
rcount = Selection.Rows.count
ccount = Selection.Columns.count

ReDim Arr(rcount, ccount)

Dim count As Integer

For Each cell In Selection
count = 0
Range(cell.Address).Activate

count = count + ActiveCell.Offset(1, -1).Value
count = count + ActiveCell.Offset(1, 0).Value
count = count + ActiveCell.Offset(1, 1).Value
count = count + ActiveCell.Offset(0, -1).Value
count = count + ActiveCell.Offset(0, 1).Value
count = count + ActiveCell.Offset(-1, -1).Value
count = count + ActiveCell.Offset(-1, 0).Value
count = count + ActiveCell.Offset(-1, 1).Value

If cell.Value = 1 Then
Select Case count
Case Is < 2
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Is 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
End Select
Else
Select Case count
Case Is = 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
End Select
End If
Next cell

Dim rval As Integer
Dim cval As Integer

For Each cell In Selection
rval = cell.Row - 3
cval = cell.Column - 2
Range(cell.Address).Value = Arr(rval, cval)
Select Case cell.Value

End Select
Next cell

rng.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="1"
Selection.FormatConditions(1).Interior.ColorIndex = 1
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = 2

Range("B1").Value = Range("B1").Value + 1
Range("a1").Select
End Sub


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Why does this coding not work?

Jim

Thanks for your reply.

However, some code which will be run directly before this defines the
range.

So this code shown above, the range should already have been defined.

Does that make sense?

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default Why does this coding not work?

Don't select anything. Selecting is bad....

Try the code below, with your field of "Life" named "LifeRange"

Note that the upper left of your LifeRange shouldn't be closer to A1 than
C3.

As written, this code will do 100 generations. To change that, take out

For Gens = 1 to 100

and take out

Next Gens

HTH,
Bernie
MS Excel MVP

Sub NextGeneration2()

Dim Rng As Range
Dim Cell As Range
Dim Arr() As Variant
Dim rCount As Integer
Dim cCount As Integer
Dim Count As Integer
Dim rVal As Integer
Dim cVal As Integer
Dim ROff As Integer
Dim COff As Integer
Dim Gens As Integer

Set Rng = Range("LifeRange")
With Rng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 1
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="0"
.FormatConditions(2).Font.ColorIndex = 2
End With

On Error Resume Next
Range("B1").Value = 1

For Gens = 1 To 100

Application.ScreenUpdating = False

rCount = Rng.Rows.Count
cCount = Rng.Columns.Count
ROff = Rng(1).Row - 1
COff = Rng(1).Column - 1

ReDim Arr(1 To rCount, 1 To cCount)

For Each Cell In Rng
Count = Application.Sum(Cell(0, 0).Resize(3, 3)) - Cell.Value
If Cell.Value = 1 Then
Select Case Count
Case Is < 2
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
Case Is 3
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
Case Else
Arr(Cell.Row - ROff, Cell.Column - COff) = 1
End Select
Else
Select Case Count
Case Is = 3
Arr(Cell.Row - ROff, Cell.Column - COff) = 1
Case Else
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
End Select
End If
Next Cell

Rng.Value = Arr()

Range("B1").Value = Range("B1").Value + 1
Application.ScreenUpdating = True
Next Gens

End Sub


"rammieib" wrote in message
oups.com...
Hello.

I have produced the following coding, but for the range which is
selected beforehand, it coding only covers some of the range, not all
of it?

any ideas? (Has to be with option explicit on)

Sub nextgeneration()

Private rng As Range
Private cell As Range

Dim rcount As Integer
Dim ccount As Integer

On Error Resume Next
Dim Arr()
rng.Select
rcount = Selection.Rows.count
ccount = Selection.Columns.count

ReDim Arr(rcount, ccount)

Dim count As Integer

For Each cell In Selection
count = 0
Range(cell.Address).Activate

count = count + ActiveCell.Offset(1, -1).Value
count = count + ActiveCell.Offset(1, 0).Value
count = count + ActiveCell.Offset(1, 1).Value
count = count + ActiveCell.Offset(0, -1).Value
count = count + ActiveCell.Offset(0, 1).Value
count = count + ActiveCell.Offset(-1, -1).Value
count = count + ActiveCell.Offset(-1, 0).Value
count = count + ActiveCell.Offset(-1, 1).Value

If cell.Value = 1 Then
Select Case count
Case Is < 2
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Is 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
End Select
Else
Select Case count
Case Is = 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
End Select
End If
Next cell

Dim rval As Integer
Dim cval As Integer

For Each cell In Selection
rval = cell.Row - 3
cval = cell.Column - 2
Range(cell.Address).Value = Arr(rval, cval)
Select Case cell.Value

End Select
Next cell

rng.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="1"
Selection.FormatConditions(1).Interior.ColorIndex = 1
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = 2

Range("B1").Value = Range("B1").Value + 1
Range("a1").Select
End Sub



  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default Why does this coding not work?

Actually, it looks better with the screenupdating lines removed....

Bernie


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Don't select anything. Selecting is bad....

Try the code below, with your field of "Life" named "LifeRange"

Note that the upper left of your LifeRange shouldn't be closer to A1 than
C3.

As written, this code will do 100 generations. To change that, take out

For Gens = 1 to 100

and take out

Next Gens

HTH,
Bernie
MS Excel MVP

Sub NextGeneration2()

Dim Rng As Range
Dim Cell As Range
Dim Arr() As Variant
Dim rCount As Integer
Dim cCount As Integer
Dim Count As Integer
Dim rVal As Integer
Dim cVal As Integer
Dim ROff As Integer
Dim COff As Integer
Dim Gens As Integer

Set Rng = Range("LifeRange")
With Rng
.FormatConditions.Delete
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="1"
.FormatConditions(1).Interior.ColorIndex = 1
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="0"
.FormatConditions(2).Font.ColorIndex = 2
End With

On Error Resume Next
Range("B1").Value = 1

For Gens = 1 To 100

Application.ScreenUpdating = False

rCount = Rng.Rows.Count
cCount = Rng.Columns.Count
ROff = Rng(1).Row - 1
COff = Rng(1).Column - 1

ReDim Arr(1 To rCount, 1 To cCount)

For Each Cell In Rng
Count = Application.Sum(Cell(0, 0).Resize(3, 3)) - Cell.Value
If Cell.Value = 1 Then
Select Case Count
Case Is < 2
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
Case Is 3
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
Case Else
Arr(Cell.Row - ROff, Cell.Column - COff) = 1
End Select
Else
Select Case Count
Case Is = 3
Arr(Cell.Row - ROff, Cell.Column - COff) = 1
Case Else
Arr(Cell.Row - ROff, Cell.Column - COff) = 0
End Select
End If
Next Cell

Rng.Value = Arr()

Range("B1").Value = Range("B1").Value + 1
Application.ScreenUpdating = True
Next Gens

End Sub


"rammieib" wrote in message
oups.com...
Hello.

I have produced the following coding, but for the range which is
selected beforehand, it coding only covers some of the range, not all
of it?

any ideas? (Has to be with option explicit on)

Sub nextgeneration()

Private rng As Range
Private cell As Range

Dim rcount As Integer
Dim ccount As Integer

On Error Resume Next
Dim Arr()
rng.Select
rcount = Selection.Rows.count
ccount = Selection.Columns.count

ReDim Arr(rcount, ccount)

Dim count As Integer

For Each cell In Selection
count = 0
Range(cell.Address).Activate

count = count + ActiveCell.Offset(1, -1).Value
count = count + ActiveCell.Offset(1, 0).Value
count = count + ActiveCell.Offset(1, 1).Value
count = count + ActiveCell.Offset(0, -1).Value
count = count + ActiveCell.Offset(0, 1).Value
count = count + ActiveCell.Offset(-1, -1).Value
count = count + ActiveCell.Offset(-1, 0).Value
count = count + ActiveCell.Offset(-1, 1).Value

If cell.Value = 1 Then
Select Case count
Case Is < 2
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Is 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
End Select
Else
Select Case count
Case Is = 3
Arr((cell.Row) - 3, (cell.Column) - 2) = 1
Case Else
Arr((cell.Row) - 3, (cell.Column) - 2) = 0
End Select
End If
Next cell

Dim rval As Integer
Dim cval As Integer

For Each cell In Selection
rval = cell.Row - 3
cval = cell.Column - 2
Range(cell.Address).Value = Arr(rval, cval)
Select Case cell.Value

End Select
Next cell

rng.Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="1"
Selection.FormatConditions(1).Interior.ColorIndex = 1
Selection.FormatConditions.Add Type:=xlCellValue,
Operator:=xlEqual, _
Formula1:="0"
Selection.FormatConditions(2).Font.ColorIndex = 2

Range("B1").Value = Range("B1").Value + 1
Range("a1").Select
End Sub







  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Why does this coding not work?

Bernie

Thanks for your reply, however, I keep getting debug with the line:

Set Rng = Range("LifeRange")

Why, when in a macro run earlier in which the defined range will be
set, and is called rng, is it useful to rename the range to liferange?

  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 5,441
Default Why does this coding not work?

Take that line out, if you have already set Rng. I needed to do it to test
my version, since your sub did not include a Set Rng statement.

Bernie

"rammieib" wrote in message
ups.com...
Bernie

Thanks for your reply, however, I keep getting debug with the line:

Set Rng = Range("LifeRange")

Why, when in a macro run earlier in which the defined range will be
set, and is called rng, is it useful to rename the range to liferange?



  #8   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 16
Default Why does this coding not work?

Bernie

Thanks, I played around with it and got it to work.

Cheers

Roger

Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
VB Coding johnsail Excel Discussion (Misc queries) 1 February 18th 10 12:54 PM
work sheet coding Dad Excel Discussion (Misc queries) 3 December 23rd 07 11:08 PM
"=ROW()-1" type of coding doesn't appear in a filter / is there coding that does? StargateFan[_3_] Excel Programming 10 October 6th 05 01:18 PM
Implant macro coding into ASP coding Sam yong Excel Programming 5 September 15th 05 10:37 AM
coding Hardy Excel Discussion (Misc queries) 1 February 22nd 05 04:58 PM


All times are GMT +1. The time now is 01:46 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"