View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
rammieib rammieib is offline
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