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