ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Why does this coding not work? (https://www.excelbanter.com/excel-programming/353818-why-does-coding-not-work.html)

rammieib
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

Jim Thomlinson[_5_]
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

Bernie Deitrick
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

Bernie Deitrick
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

rammieib
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?

rammieib
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?

Bernie Deitrick
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?

rammieib
Why does this coding not work?
 
Bernie

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

Cheers

Roger


All times are GMT +1. The time now is 05:33 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com