Needs Help with a Nested "FOR.. NEXT" Loop

[carts]

Hi everyone! I am trying to write a nested “FOR… NEXT” loop to create the following table in Excel



Any help is much appreciated!

 

[Hui]

Not VBA but a formula
A1: =IF(and(isodd(row(a1)),isodd(column(a1))),”Odd”, if(and(iseven(row(a1)),iseven(column(a1))),”Even”,””))
Copy across and down

 

[carts]

@Hui Hi! I am actually learning how to use vba right now so that's why I was asking for a sample vba

 

[NARAYANK991]

Hi ,

Try this :

Public Sub FillOddsAndEvens()
           With Range("A1:T22")
                .Formula = "=IF(and(isodd(row(a1)),isodd(column(a1))),""Odd"", if(and(iseven(row(a1)),iseven(column(a1))),""Even"",""""))"
                .Value = .Value
           End With
End Sub

Narayan

 

[carts]

Hi @NARAYANK991 Thanks so much! Is it possible for me to change colors for the same purpose using this code?

Like, for example..

 

[Hui]

I was traveling so had limited resources

 

[carts]

@Hui It's alright! I appreciate all the help I can get

 

[NARAYANK991]

Hi ,

Try this :

Public Sub FillOddsAndEvens()
          Dim fillrange As Range
          Dim filltext As String
          Dim numcols As Long, numrows As Long, fillcolor As Long, i As Long, j As Long

          Set fillrange = Range("A1:T22")
         
          With fillrange
                numcols = .Columns.Count
                numrows = .Rows.Count
          End With
           
          Application.ScreenUpdating = False
         
          For i = 1 To numrows
              If ((i Mod 2) = 0) Then
                  fillcolor = vbWhite
                  filltext = "Even"
              Else
                  fillcolor = vbYellow
                  filltext = "Odd"
              End If
             
              For j = 1 To numcols
                  With fillrange.Cells(i, j)
                        If ((j Mod 2) = (i Mod 2)) Then
                          .Value = filltext
                          .Interior.Color = fillcolor
                        End If
                        fillcolor = IIf(fillcolor = vbWhite, vbYellow, vbWhite)
                  End With
              Next
          Next
         
          Application.ScreenUpdating = True
End Sub

Narayan

 

[Hui]

I was looking at Narayan's code and thought I could improve it slightly

So I used a For each construct with a range object as shown below

Public Sub FillOddsAndEvens2()
Dim fillrange As Range
Dim filltext As String
Dim fillcolor As Long
Dim c As Range

Set fillrange = Range("A1:T22")

Application.ScreenUpdating = False

For Each c In fillrange
  If (c.Column Mod 2) = (c.Row Mod 2) Then
      fillcolor = vbYellow
      filltext = "Even"
      If ((c.Row Mod 2) = 1) Or ((c.Column Mod 2) = 1) Then filltext = "Odd"
  Else
      fillcolor = vbWhite
      filltext = ""
  End If

  c.Interior.Color = fillcolor
  c.Value = filltext

Next

Application.ScreenUpdating = True

End Sub

It works fine


However when I timed it it is actually about 40% slower than Narayan's
Results below are the average of 10 runs

FillOddsAndEvens
Time = 0.1097656 seconds

FillOddsAndEvens2
Time = 0.2628906 seconds

I am working on another technique and will post about it later

 

[Hui]

Technique 3

This time I save time by only writing to the Worksheet once

Public Sub FillOddsAndEvens3()
Dim fillrange As Range
Dim filltext As String
Dim numcols As Long, numrows As Long, fillcolor As Long, i As Long, j As Long
Dim myArr(1 To 22, 1 To 20) As String

Set fillrange = Range("A1:T22")

With fillrange
      numcols = .Columns.Count
      numrows = .Rows.Count
End With
Application.ScreenUpdating = False

For i = 1 To numrows
  If ((i Mod 2) = 0) Then
      fillcolor = vbWhite
      filltext = "Even"
  Else
      fillcolor = vbYellow
      filltext = "Odd"
  End If
 
  For j = 1 To numcols
      With fillrange.Cells(i, j)
        If ((j Mod 2) = (i Mod 2)) Then
            myArr(i, j) = filltext
            '.Interior.Color = fillcolor
        End If
      fillcolor = IIf(fillcolor = vbWhite, vbYellow, vbWhite)
      End With
  Next
Next

'Write all values to the worksheet
Range("A1:T22").Value = myArr

Application.ScreenUpdating = True
End Sub

I have cheated and used Conditional Formatting for the Coloring

FillOddsAndEvens
Time = 0.1097656

FillOddsAndEvens2
Time = 0.2628906

FillOddsAndEvens3
Time = 0.06210937

About 40% faster than FillOddsAndEvens